1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4         *                                                         *
   5         *********************************************************** */
   6 
   7 
   8 /****^  HISTORY COMMENTS:
   9   1) change(86-08-18,JSLove), approve(86-08-18,MCR7518),
  10      audit(86-08-21,Parisek), install(86-10-02,MR12.0-1175):
  11      Changed to call match_star_name_ instead of linus_match_star_name.
  12      Linus_match_star_name was deleted when the new match_star_name_ was
  13      installed.
  14                                                    END HISTORY COMMENTS */
  15 
  16 
  17 /* format: off */
  18 %skip(1);
  19 linus_options: proc;
  20 %skip(1);
  21 /*
  22 
  23      This module provides an interface to the options used in formatting
  24      reports. The following external entry points in order of appearance
  25      are available:
  26 
  27      initialize
  28 
  29      Called by all format related requests when they are invoked.
  30      It takes care of making sure everything is up to date, allocated, etc.
  31 
  32      terminate
  33 
  34      Called by linus termination code if lcb.report_control_info_ptr is
  35      non-null.  It takes care of undoing everything this subroutine does
  36      during the course of a linus session.
  37 
  38      check_identifier
  39 
  40      Called to check a column/option identifier.  Translates an option name
  41      and option identifier into a character string consisting of the option
  42      name and real option identifier (i.e.  translates 1 into the name of
  43      column 1.) Can also be used to determine if the column name is a star
  44      name.
  45 
  46      check_name
  47 
  48      Called to check an option name, expand the short option name into a
  49      long name, and determine if it needs a column/option identifier.
  50 
  51      get
  52 
  53      Called to get the value of a formatting option.
  54 
  55      get_active
  56 
  57      Called to get the names and values of the active formatting
  58      options.
  59 ^L
  60      get_all
  61 
  62      Called to get the names and values of all of the formatting
  63      options.
  64 
  65      get_named
  66 
  67      Called to get the names and values of a set of formatting options.  The
  68      options are named by the caller, but the names of columns can be names,
  69      star names or numbers.  The names returned by this module are actual
  70      column names instead of numbers or star names.
  71 
  72      set_and_check
  73 
  74      Called to set a formatting option to a provided value.  The option
  75      name and value are checked for validity.
  76 
  77      set_all_to_system_defaults
  78 
  79      Called to set all of the formatting options to their default
  80      values.
  81 
  82 
  83 
  84      Known Bugs:
  85 
  86      Other Problems:
  87 
  88      History:
  89 
  90      Written - Al Dupuis - August 1983
  91 
  92 
  93 */
  94 %page;
  95 %skip(3);
  96 /* These parameters are described at each entry where they are used. */
  97 %skip(3);
  98 dcl code_parm fixed bin (35) parm;
  99 dcl identifier_needed_parm bit (1) aligned parm;
 100 dcl lcb_ptr_parm ptr parm;
 101 dcl long_option_name_parm char (*) varying parm;
 102 dcl names_and_values_info_ptr_parm ptr parm;
 103 dcl names_and_values_ptr_parm ptr parm;
 104 dcl no_of_names_and_values_parm fixed bin (21) parm;
 105 dcl no_of_options_in_name_table_parm fixed bin (21) parm;
 106 dcl normalized_option_name_parm char (*) varying parm;
 107 dcl option_identifier_parm char (*) varying parm;
 108 dcl option_name_parm char (*) varying parm;
 109 dcl option_name_table_ptr_parm ptr parm;
 110 dcl option_value_parm char (*) varying parm;
 111 dcl size_of_names_and_values_parm fixed bin (21) parm;
 112 dcl system_default_parm bit (1) aligned parm;
 113 %skip(5);
 114           call ssu_$abort_line (lcb.subsystem_control_info_ptr, 0,
 115                "This is not a valid entrypoint.");
 116 %page;
 117 initialize: entry (
 118 %skip(1);
 119           lcb_ptr_parm, /* input: pointer to the linus control block */
 120           code_parm     /* output: success or failure */
 121                  );
 122 %skip(1);
 123 /*
 124 
 125      This entry point is called by the display, set_format_options,
 126      list_format_options, save_format_options and restore_format_options
 127      requests when they are invoked.  It is not called by column_value or
 128      display_builtins, and should not be called by any future active requests
 129      like column_value when they are implemented. This code makes sure that:
 130 
 131      1) The linus options value seg is created; that the value seg is loaded
 132      with the system defaults; that 3 areas for allocations are created; and
 133      that 9 temp segments are created.  This is done once per linus invocation.
 134 
 135      2) That the area used for allocations of name value pairs is emptied.
 136      This is done once per invocation of this entrypoint.
 137 
 138      3) That the options which refer to columns are up to date.  This means
 139      deleting the old column options and loading the value seg with the new
 140      column default options if the user has done a lila proc since the last
 141      time this entry was called, or deleting the old column options if the
 142      user has done an unsuccessful lila proc since the last time this entry
 143      was called.
 144 
 145 */
 146 %skip(1);
 147           me = "linus_options$initialize";
 148           lcb_ptr = lcb_ptr_parm;
 149           code_parm = 0;
 150 %skip(1);
 151           if lcb.report_control_info_ptr = null ()
 152           then do;
 153                call setup_to_do_reporting;
 154                lcb.report_control_info_ptr = report_cip;
 155                call load_value_seg_with_report_defaults;
 156           end;
 157 %skip(1);
 158           call housekeeping;
 159           temp_seg_ptr = names_and_values_area_ptr;
 160           call release_area_ (temp_seg_ptr);
 161 %skip(1);
 162           if lcb.selection_expression_identifier = 0
 163           then return;
 164 %page;
 165 /*
 166 
 167      If we are out of date, or, there is no valid lila expression available
 168      but the column options are still around, then delete the column
 169      options.  Then if there is a valid lila selection expression available,
 170      load the new column default values.
 171 
 172 */
 173 %skip(1);
 174           if report_control_info.selection_expression_identifier
 175           ^= lcb.selection_expression_identifier
 176           | ^valid_selection_expression
 177           then do;
 178                call value_$get (value_seg_ptr, PERMANENT,
 179                     OPTIONS.GENERAL_COLUMN.NAME (1), returned_option_value, code);
 180                if code = 0
 181                then call delete_column_options;
 182                else if code ^= error_table_$oldnamerr
 183                     then call ssu_$abort_line (sci_ptr, code,
 184                          "While trying to get the value of ^a for ^a.",
 185                          OPTIONS.GENERAL_COLUMN.NAME (1), me);
 186                     else;
 187           end;
 188 %skip(1);
 189           if report_control_info.selection_expression_identifier
 190           ^= lcb.selection_expression_identifier
 191           & valid_selection_expression
 192           then call load_value_seg_with_column_defaults;
 193 %skip(1);
 194           return;
 195 %page;
 196 terminate: entry (
 197 %skip(1);
 198           lcb_ptr_parm, /* input: ptr to the linus control block */
 199           code_parm     /* output: success or failure */
 200                 );
 201 %skip(1);
 202 /*
 203 
 204      This entry point is called by the linus termination procedure when the
 205      linus user has issued the "quit" request, or cleanup of linus has been
 206      signalled.  It deletes the value segment and releases areas and temp
 207      segs set up in the setup_to_do_reporting proc. It also deletes the copy
 208      of the report if one is still laying around (i.e. the display request
 209      was invoked with "-keep_report" and linus was quit out of before display
 210      was invoked again).
 211 
 212 */
 213 %skip(1);
 214           /* Have to use this name or temp segs won't be released. */
 215 %skip(1);
 216           me = "linus_options$initialize";
 217 %skip(1);
 218           lcb_ptr = lcb_ptr_parm;
 219           code_parm = 0;
 220           sci_ptr = lcb.subsystem_control_info_ptr;
 221 %skip(1);
 222           report_cip = lcb.report_control_info_ptr;
 223           if report_control_info.flags.permanent_report
 224           then do;
 225                call linus_fr_delete_report (lcb_ptr, code);
 226                if code ^= 0
 227                then call ssu_$print_message (sci_ptr, code,
 228                     "While trying to delete the copy of the report.");
 229           end;
 230 %skip(1);
 231           /* Delete the value seg. */
 232 %skip(1);
 233           call delete_$ptr (report_control_info.value_seg_ptr,
 234                "100111"b, me, code);
 235           if code ^= 0
 236           then call ssu_$print_message (sci_ptr, code,
 237                "While trying to delete the format options.");
 238 %skip(1);
 239           /* Then the area/temp seg for name value allocations. */
 240 %skip(1);
 241           temp_seg_ptr = report_control_info.name_value_area_ptr;
 242           call release_area_ (temp_seg_ptr);
 243           call release_temp_segment (report_control_info.name_value_area_ptr);
 244 %skip(1);
 245           /* The temp seg for arrays of name-value pairs. */
 246 %skip(1);
 247           call release_temp_segment (report_control_info.name_value_temp_seg_ptr);
 248 %skip(1);
 249           /* The temp seg for report workspace. */
 250 %skip(1);
 251           call release_temp_segment (report_control_info.report_temp_seg_ptr);
 252 %skip(1);
 253           /* The temp seg and area for display workspace. */
 254 %skip(1);
 255           temp_seg_ptr = report_control_info.display_work_area_ptr;
 256           call release_area_ (temp_seg_ptr);
 257           call release_temp_segment (report_control_info.display_work_area_ptr);
 258 %skip(1);
 259           /* The temp seg and area for report allocations. */
 260 %skip(1);
 261           temp_seg_ptr = report_control_info.report_work_area_ptr;
 262           call release_area_ (temp_seg_ptr);
 263           call release_temp_segment (report_control_info.report_work_area_ptr);
 264 %skip(1);
 265           /* And the 4 temp segs for report building workspace. */
 266 %skip(1);
 267           call release_temp_segment (report_control_info.input_string_temp_seg_ptr);
 268           call release_temp_segment (report_control_info.output_string_temp_seg_ptr);
 269           call release_temp_segment (report_control_info.editing_strings_temp_seg_ptr);
 270           call release_temp_segment (report_control_info.headers_temp_seg_ptr);
 271 %skip(1);
 272           return;
 273 %page;
 274 check_identifier: entry (
 275 %skip(1);
 276           lcb_ptr_parm,                /* input: ptr to linus control block */
 277           option_name_parm,            /* input: option name to look up */
 278           option_identifier_parm,      /* input: option identifier to look up */
 279           normalized_option_name_parm, /* output: the option name and identifier */
 280           code_parm                    /* output: success or failure */
 281                );
 282 %skip(1);
 283 /*
 284 
 285      This entry is called to translate an option name and identifier into
 286      a character string that contains the option name and real option
 287      identifier. That is, an option identifier can be a number or the name
 288      of a column. The returned option identifier is always the name of the
 289      column. The option_name_parm should be the expanded version, as this
 290      entry shouldn't be called until the check_name entry was called. This
 291      entry does not support star names, but is useful for determining if
 292      the identifier is a star name.
 293 
 294 */
 295 %skip(1);
 296           me = "linus_options$check_identifier";
 297           lcb_ptr = lcb_ptr_parm;
 298           option_name = option_name_parm;
 299           option_identifier = option_identifier_parm;
 300           normalized_option_name_parm = "";
 301           code_parm = 0;
 302 %skip(1);
 303           call housekeeping;
 304 %skip(1);
 305           call normalize_option_name (option_name, option_identifier,
 306                option_type, option_table_index, normalized_option_name, code);
 307           code_parm = code;
 308           normalized_option_name_parm = normalized_option_name;
 309 %skip(1);
 310           return;
 311 %page;
 312 check_name: entry (
 313 %skip(1);
 314           lcb_ptr_parm,           /* input: ptr to linus control block */
 315           option_name_parm,       /* input: option name to determine type of */
 316           long_option_name_parm,  /* output: long version of above name */
 317           identifier_needed_parm, /* output: ON means identifier needed */
 318           code_parm               /* output: success or failure */
 319                       );
 320 %skip(1);
 321 /*
 322 
 323      This entry point is called to check an option name and determine the
 324      type of option the caller is dealing with.  There are two types of
 325      options.  Ones like "-page_size" (general report or general column
 326      options) which do not require anything else to identify them.  For these
 327      types "0"b is returned to describe their type.  Others like "-width"
 328      (specific column options) require a column number or name to identify
 329      which they apply to.  For these types "1"b is returned.  The short or
 330      long name provided is used to find the long name of the option and this
 331      long name is returned.
 332 
 333 */
 334 %skip(1);
 335           me = "linus_options$check_name";
 336           lcb_ptr = lcb_ptr_parm;
 337           option_name = option_name_parm;
 338           long_option_name_parm = "";
 339           identifier_needed_parm = OFF;
 340           code_parm = 0;
 341 %skip(1);
 342           call housekeeping;
 343 %skip(1);
 344           call expand_short_option_name (option_name, long_option_name, code);
 345           if code ^= 0
 346           then do;
 347                code_parm = code;
 348                return;
 349           end;
 350           else long_option_name_parm = long_option_name;
 351 %skip(1);
 352           call lookup_option_number (long_option_name,
 353                option_type, option_table_index);
 354           if option_type = SPECIFIC_COLUMN_OPTION
 355           then identifier_needed_parm = ON;
 356           else;
 357 %page;
 358           if ^valid_selection_expression
 359           then if (option_type = GENERAL_COLUMN_OPTION
 360                | option_type = SPECIFIC_COLUMN_OPTION)
 361                then code_parm = linus_error_$no_lila_expr_processed;
 362                else;
 363           else;
 364 %skip(1);
 365           return;
 366 %page;
 367 get:      entry (
 368 %skip(1);
 369           lcb_ptr_parm,                /* input: ptr to the linus control block */
 370           option_name_parm,            /* input: option name to get value for */
 371           option_identifier_parm,      /* input: option identifier for name */
 372           normalized_option_name_parm, /* output: the option name and identifier */
 373           option_value_parm,           /* output: option value defined for name */
 374           code_parm                    /* output: success or failure */
 375                );
 376 %skip(1);
 377 /*
 378 
 379      This entry point is called by subroutines and requests. It
 380      attempts to get the option value associated with the caller provided
 381      option name. For option names that require an identifier, the option
 382      name concatenated with a blank and the real option identifier is also
 383      returned. That is, column names rather than numbers are always returned.
 384 
 385 */
 386 %skip(1);
 387           me = "linus_options$get";
 388 %skip(1);
 389           lcb_ptr = lcb_ptr_parm;
 390           option_name = option_name_parm;
 391           option_identifier = option_identifier_parm;
 392 %skip(1);
 393           normalized_option_name_parm = "";
 394           option_value_parm = "";
 395           code_parm = 0;
 396 %skip(1);
 397           call housekeeping;
 398 %skip(1);
 399           call normalize_option_name (option_name,
 400                option_identifier, option_type, option_table_index,
 401                normalized_option_name, code);
 402           if code ^= 0
 403           then do;
 404                code_parm = code;
 405                return;
 406           end;
 407 
 408 %skip(1);
 409           call value_$get (value_seg_ptr, PERMANENT,
 410                normalized_option_name, option_value, code);
 411           if code ^= 0
 412           then call ssu_$abort_line (sci_ptr, code,
 413                "While trying to get the value for ^a.",
 414                normalized_option_name_parm);
 415 %skip(1);
 416           normalized_option_name_parm = normalized_option_name;
 417           option_value_parm = option_value;
 418 %skip(1);
 419           return;
 420 %page;
 421 get_active: entry (
 422 %skip(1);
 423           lcb_ptr_parm,                   /* input: ptr to the linus control block */
 424           names_and_values_info_ptr_parm, /* output: ptr to names and values info */
 425           no_of_names_and_values_parm,    /* output: no of name-value pairs */
 426           names_and_values_ptr_parm,      /* output: ptr to the names and values */
 427           size_of_names_and_values_parm,  /* output: length of names_and_values char string */
 428           code_parm                       /* output: success or failure */
 429                 );
 430 %skip(1);
 431 /*
 432 
 433      This entrypoint is called by the linus list_format_options and
 434      save_format_options requests to get all the active formatting option
 435      names and values.  They are returned as a character string, along
 436      with a structure which describes the character string.
 437 
 438 */
 439 %skip(1);
 440           me = "linus_options$get_active";
 441           lcb_ptr = lcb_ptr_parm;
 442           names_and_values_info_ptr_parm = null ();
 443           no_of_names_and_values_parm = 0;
 444           names_and_values_ptr_parm = null ();
 445           size_of_names_and_values_parm = 0;
 446           code_parm = 0;
 447 %skip(1);
 448           call housekeeping;
 449 %skip(1);
 450           call get_all_names_and_values;
 451           call extract_active_from_all;
 452 %skip(1);
 453           names_and_values_info_ptr_parm = like_names_and_values_info_ptr;
 454           no_of_names_and_values_parm = no_of_active_names_and_values;
 455           names_and_values_ptr_parm = names_and_values_ptr;
 456           size_of_names_and_values_parm = size_of_names_and_values;
 457 %skip(1);
 458           return;
 459 %page;
 460 get_all: entry (
 461 %skip(1);
 462           lcb_ptr_parm,                   /* input: ptr to the linus control block */
 463           names_and_values_info_ptr_parm, /* output: ptr to names and values info */
 464           no_of_names_and_values_parm,    /* output: no of name-value pairs */
 465           names_and_values_ptr_parm,      /* output: ptr to the names and values */
 466           size_of_names_and_values_parm,  /* output: length of names_and_values char string */
 467           code_parm                       /* output: success or failure */
 468                 );
 469 %skip(1);
 470 /*
 471 
 472      This entrypoint is called by the linus list_format_options and
 473      save_format_options requests to get all of the formatting option names
 474      and values.  They are returned as a character string, along with a
 475      structure which describes the character string.
 476 
 477 */
 478 %skip(1);
 479           me = "linus_options$get_all";
 480           lcb_ptr = lcb_ptr_parm;
 481           names_and_values_info_ptr_parm = null ();
 482           no_of_names_and_values_parm = 0;
 483           names_and_values_ptr_parm = null ();
 484           size_of_names_and_values_parm = 0;
 485           code_parm = 0;
 486 %skip(1);
 487           call housekeeping;
 488 %skip(1);
 489           call get_all_names_and_values;
 490 %skip(1);
 491           names_and_values_info_ptr_parm = names_and_values_info_ptr;
 492           no_of_names_and_values_parm = no_of_names_and_values;
 493           names_and_values_ptr_parm = names_and_values_ptr;
 494           size_of_names_and_values_parm = size_of_names_and_values;
 495 %skip(1);
 496           return;
 497 %page;
 498 get_named: entry (
 499 %skip(1);
 500           lcb_ptr_parm,                     /* input: ptr to the linus control block */
 501           option_name_table_ptr_parm,       /* input: an array of option names and identifiers */
 502           no_of_options_in_name_table_parm, /* input: no of option names */
 503           names_and_values_info_ptr_parm,   /* output: ptr to names and values info */
 504           no_of_names_and_values_parm,      /* output: no of name value pairs */
 505           names_and_values_ptr_parm,        /* output: ptr to the names and values */
 506           size_of_names_and_values_parm,    /* output: length of names_and_values char string */
 507           code_parm                         /* output: success or failure */
 508                 );
 509 %skip(1);
 510 /*
 511 
 512      This entrypoint is called by the linus save_format_options and
 513      list_format_options requests.  It takes an array of names as input and
 514      creates a character string containing all of the names and values, along
 515      with a structure which describes the character string.
 516 
 517 */
 518 %skip(1);
 519           me = "linus_options$get_named";
 520           lcb_ptr = lcb_ptr_parm;
 521           option_name_table_ptr = option_name_table_ptr_parm;
 522           no_of_options_in_name_table = no_of_options_in_name_table_parm;
 523           names_and_values_info_ptr_parm = null();
 524           no_of_names_and_values_parm = 0;
 525           names_and_values_ptr_parm = null ();
 526           size_of_names_and_values_parm = 0;
 527           code_parm = 0;
 528 %skip(1);
 529           call housekeeping;
 530 %skip(1);
 531           call get_named_values (code);
 532           if code ^= 0
 533           then code_parm = code;
 534           else do;
 535                names_and_values_info_ptr_parm = names_and_values_info_ptr;
 536                no_of_names_and_values_parm = no_of_names_and_values;
 537                names_and_values_ptr_parm = names_and_values_ptr;
 538                size_of_names_and_values_parm = size_of_names_and_values;
 539           end;
 540 %skip(1);
 541           return;
 542 %page;
 543 set_and_check: entry (
 544 %skip(1);
 545           lcb_ptr_parm,           /* input: ptr to linus control block */
 546           option_name_parm,       /* input: option name to set value for */
 547           option_identifier_parm, /* input: option identifier for name */
 548           option_value_parm,      /* input: option value to set */
 549           system_default_parm,    /* input: on = set value to system default */
 550           code_parm               /* output: success or failure */
 551                     );
 552 %skip(1);
 553 /*
 554 
 555      This entry point is called by the set_format_options request to set a user
 556      specified option name to either a user provided option value or the system
 557      provided default.  It first makes sure that the option name is valid.  The
 558      caller should have first called the check_name entry of this
 559      suboutine and had the option name expanded and checked at that time.  If
 560      the user has requested that it be set to the system default value, it sets
 561      it from system tables.  Otherwise it determines if the value is legitimate
 562      for the particular option.  It is then set if the value is correct.
 563 
 564 */
 565 %skip(1);
 566           me = "linus_options$set_and_check";
 567           lcb_ptr = lcb_ptr_parm;
 568           option_name = option_name_parm;
 569           option_identifier = option_identifier_parm;
 570           option_value = option_value_parm;
 571           system_default = system_default_parm;
 572           code_parm = 0;
 573 %skip(1);
 574           call housekeeping;
 575 %skip(1);
 576           call set_the_values (option_name, option_identifier,
 577                option_value, system_default, code);
 578           code_parm = code;
 579 %skip(1);
 580           return;
 581 %page;
 582 set_all_to_system_defaults: entry (
 583 %skip(1);
 584           lcb_ptr,  /* input: ptr to linus control block */
 585           code_parm /* output: success or failure */
 586                                  );
 587 %skip(1);
 588 /*
 589 
 590      This entrypoint is called by the set_format_options request to set all
 591      of the formatting options to the system provided defaults.  It first
 592      sets the general report options. It then sets the general and specific
 593      column options if a valid lila statement is available. If there are old
 594      column options hanging around they are deleted before the set operation.
 595 
 596 */
 597 %skip(1);
 598           me = "linus_options$set_all_to_system_defaults";
 599           lcb_ptr = lcb_ptr_parm;
 600           code_parm = 0;
 601 %skip(1);
 602           call housekeeping;
 603           call load_value_seg_with_report_defaults;
 604 %skip(1);
 605           if ^valid_selection_expression
 606           then return;
 607 %skip(1);
 608           call value_$get (value_seg_ptr, PERMANENT,
 609                OPTIONS.GENERAL_COLUMN.NAME (1), returned_option_value, code);
 610           if code = 0
 611           then call delete_column_options;
 612           else if code ^= error_table_$oldnamerr
 613                then call ssu_$abort_line (sci_ptr, code,
 614                     "While trying to get the value of ^a for ^a.",
 615                     OPTIONS.GENERAL_COLUMN.NAME (1), me);
 616                else;
 617 %skip(1);
 618           call load_value_seg_with_column_defaults;
 619 %skip(1);
 620           return;
 621 %page;
 622 delete_column_options: proc;
 623 %skip(3);
 624 /*
 625 
 626      This proc is called to delete the column option names and values so that
 627      leftover column options from another select don't get confused with the
 628      current column options. If it runs into trouble the line is aborted
 629      here because reporting can't possibly continue.
 630 
 631 */
 632 %skip(1);
 633 dcl dco_inner_loop fixed bin;
 634 dcl dco_loop fixed bin;
 635 %skip(1);
 636           alloc_name_count = NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE
 637                + NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
 638           alloc_max_name_len = max (LONGEST_SPECIFIC_COLUMN_OPTION_NAME_LENGTH,
 639                LONGEST_GENERAL_COLUMN_OPTION_NAME_LENGTH)
 640                + length (BLANK) + length (STAR_DOT_STAR_STAR);
 641           allocate match_info in (names_and_values_area)
 642                set (match_info_ptr);
 643           match_info.version = match_info_version_1;
 644 %skip(1);
 645           do dco_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
 646 %skip(1);
 647                match_info.name_array.exclude_sw (dco_loop) = OFF;
 648                match_info.name_array.regexp_sw (dco_loop) = OFF;
 649                match_info.name_array.name (dco_loop)
 650                     = OPTIONS.GENERAL_COLUMN.NAME (dco_loop);
 651 %skip(1);
 652           end;
 653 %skip(1);
 654           dco_inner_loop = NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE + 1;
 655 %skip(1);
 656           do dco_loop = 1 to NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
 657 %skip(1);
 658                match_info.name_array.exclude_sw (dco_inner_loop) = OFF;
 659                match_info.name_array.regexp_sw (dco_inner_loop) = OFF;
 660                match_info.name_array.name (dco_inner_loop) =
 661                     OPTIONS.SPECIFIC_COLUMN.NAME (dco_loop)
 662                     || BLANK || STAR_DOT_STAR_STAR;
 663                dco_inner_loop = dco_inner_loop + 1;
 664 %skip(1);
 665           end;
 666 %page;
 667           call value_$list (value_seg_ptr, PERMANENT, match_info_ptr,
 668                names_and_values_area_ptr, value_list_info_ptr, code);
 669           if code ^= 0
 670           then call ssu_$abort_line (sci_ptr, code,
 671                "^a", "While trying to get the option names for the columns.");
 672 %skip(1);
 673           do dco_loop = 1 to value_list_info.pair_count;
 674 %skip(1);
 675                call value_$delete (value_seg_ptr, PERMANENT,
 676                     substr (value_list_info.chars,
 677                     value_list_info.pairs.name_index (dco_loop),
 678                     value_list_info.pairs.name_len (dco_loop)), code);
 679                if code ^= 0
 680                then call ssu_$abort_line (sci_ptr, code,
 681                     "While trying to delete the value of ^a.",
 682                     substr (value_list_info.chars,
 683                     value_list_info.pairs.name_index (dco_loop),
 684                     value_list_info.pairs.name_len (dco_loop)));
 685 %skip(1);
 686           end;
 687 %skip(1);
 688           report_control_info.options_identifier =
 689                report_control_info.options_identifier + 1;
 690 %skip(1);
 691           return;
 692 %skip(1);
 693      end delete_column_options;
 694 %page;
 695 expand_short_option_name: proc (
 696 
 697           eson_option_name_parm,       /* input: option name to expand */
 698           eson_long_option_name_parm,  /* output: long version of option name */
 699           eson_code_parm               /* output: success or failure */
 700                                );
 701 %skip(3);
 702 /*
 703 
 704      When this proc is called it expects eson_option_name_parm to contain the
 705      short or long option name.  It sets eson_long_option_name_parm based on
 706      the value of eson_option_name_parm.  If the name isn't valid it sets
 707      eson_code_parm to reflect this.  It first does a binary table search on
 708      the short_names table and if it's unsucessful it does the same to the
 709      long_names table.
 710 
 711 */
 712 %skip(1);
 713 dcl eson_code_parm fixed bin (35) parm;
 714 dcl eson_long_option_name_parm char (*) varying parm;
 715 dcl eson_option_name_parm char (*) varying parm;
 716 dcl eson_table_index fixed bin;
 717 %skip(3);
 718           eson_long_option_name_parm = "";
 719           eson_code_parm = 0;
 720 %skip(1);
 721           eson_table_index = lookup_name_from_table (eson_option_name_parm,
 722                OPTION_NAMES_AS_ARGS.SHORT_NAME);
 723           if eson_table_index ^= 0
 724           then do;
 725                eson_long_option_name_parm = OPTION_NAMES_AS_ARGS.
 726                     LONG_NAME_IN_SHORT_NAME_ORDER (eson_table_index);
 727                return;
 728           end;
 729 %skip(1);
 730           eson_table_index = lookup_name_from_table (eson_option_name_parm,
 731                OPTION_NAMES_AS_ARGS.LONG_NAME);
 732           if eson_table_index ^= 0
 733           then eson_long_option_name_parm = eson_option_name_parm;
 734           else eson_code_parm = linus_error_$bad_option_name;
 735 %skip(1);
 736           return;
 737 %page;
 738 lookup_name_from_table: proc (
 739 
 740           lnft_name_parm, /* input: name to look up */
 741           lnft_table_parm /* output: table to do lookup from */
 742                              ) returns (fixed bin);
 743 %skip(3);
 744 dcl lnft_loop1 fixed bin;
 745 dcl lnft_loop2 fixed bin;
 746 dcl lnft_loop3 fixed bin;
 747 dcl lnft_name_parm char (*) varying parm;
 748 dcl lnft_table_parm (*) char (*) varying parm;
 749 %skip(1);
 750           lnft_loop1 = 1;
 751           lnft_loop2 = hbound (lnft_table_parm, 1);
 752 %skip(1);
 753           do while (lnft_loop1 <= lnft_loop2);
 754 %skip(1);
 755                lnft_loop3 = divide (lnft_loop1 + lnft_loop2, 2, 17);
 756                if lnft_name_parm = lnft_table_parm (lnft_loop3)
 757                then return (lnft_loop3);
 758 %skip(1);
 759                if lnft_name_parm < lnft_table_parm (lnft_loop3)
 760                then lnft_loop2 = lnft_loop3 - 1;
 761                else lnft_loop1 = lnft_loop3 + 1;
 762 %skip(1);
 763           end;
 764 %skip(1);
 765           return (0);
 766 %skip(1);
 767      end lookup_name_from_table;
 768 %skip(3);
 769      end expand_short_option_name;
 770 %page;
 771 extract_active_from_all: proc;
 772 %skip(3);
 773 /*
 774 
 775      This proc is called by the entry get_active to extract the names and
 776      values from the value list structures that are considered active.  It
 777      expects that get_all_names_and_values has just been called, and moves the
 778      index and length of each name and value considered active, into a
 779      structure returned to the caller of the get_active entrypoint.
 780 
 781 */
 782 %skip(1);
 783 dcl eafa_inner_loop fixed bin;
 784 dcl eafa_loop fixed bin;
 785 %skip(3);
 786           no_of_names_and_values_in_bit_map = no_of_names_and_values;
 787           no_of_active_names_and_values = no_of_names_and_values;
 788 %skip(1);
 789           allocate names_and_values_bit_map in (names_and_values_area)
 790                set (names_and_values_bit_map_ptr);
 791           unspec (names_and_values_bit_map) = OFF;
 792 %skip(1);
 793           do eafa_loop = 1 to NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
 794 %skip(1);
 795                if report_control_info.format_options_flags.
 796                     general_report_default_value (eafa_loop)
 797                then do;
 798                     names_and_values_bit_map (eafa_loop) = ON;
 799                     no_of_active_names_and_values =
 800                          no_of_active_names_and_values - 1;
 801                end;
 802 %skip(1);
 803           end;
 804 %page;
 805           if valid_selection_expression
 806           then do;
 807                eafa_inner_loop = NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE + 1;
 808                do eafa_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
 809                     if report_control_info.format_options_flags
 810                          .general_column_default_value (eafa_loop)
 811                     then do;
 812                          names_and_values_bit_map (eafa_inner_loop) = ON;
 813                          no_of_active_names_and_values =
 814                               no_of_active_names_and_values - 1;
 815                     end;
 816                     eafa_inner_loop = eafa_inner_loop + 1;
 817                end;
 818           end;
 819 %skip(1);
 820           allocate like_name_value_info in (names_and_values_area)
 821                set (like_names_and_values_info_ptr);
 822 %skip(1);
 823           eafa_inner_loop = 1;
 824 %skip(1);
 825           do eafa_loop = 1 to no_of_names_and_values_in_bit_map;
 826                if names_and_values_bit_map (eafa_loop) = OFF
 827                then do;
 828                     like_name_value_info.name.index (eafa_inner_loop) =
 829                          name_value_info.name.index (eafa_loop);
 830                     like_name_value_info.name.length (eafa_inner_loop) =
 831                          name_value_info.name.length (eafa_loop);
 832                     like_name_value_info.value.index (eafa_inner_loop) =
 833                          name_value_info.value.index (eafa_loop);
 834                     like_name_value_info.value.length (eafa_inner_loop) =
 835                          name_value_info.value.length (eafa_loop);
 836                     eafa_inner_loop = eafa_inner_loop + 1;
 837                end;
 838           end;
 839 %skip(1);
 840           return;
 841 %skip(1);
 842      end extract_active_from_all;
 843 %page;
 844 get_all_names_and_values: proc;
 845 %skip(3);
 846 /*
 847 
 848      This proc is called to obtain all of the names and values.  It first gets
 849      the general report options.  Then, if there are column options defined,
 850      the general column options are gotten, followed by the specific column
 851      options.
 852 
 853 */
 854 %skip(1);
 855 dcl ganav_inner_loop fixed bin;
 856 dcl ganav_loop fixed bin;
 857 dcl ganav_loop_limit fixed bin;
 858 dcl ganav_no_of_chars_already_done fixed bin (21);
 859 %skip(3);
 860           /* Get the names and values for the general report options. */
 861 %skip(1);
 862           alloc_name_count = NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
 863           alloc_max_name_len = LONGEST_GENERAL_REPORT_OPTION_NAME_LENGTH;
 864           allocate match_info in (names_and_values_area) set (match_info_ptr);
 865           match_info.version = match_info_version_1;
 866 %skip(1);
 867           do ganav_loop = 1 to NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
 868 %skip(1);
 869                match_info.name_array.exclude_sw (ganav_loop) = OFF;
 870                match_info.name_array.regexp_sw (ganav_loop) = OFF;
 871                match_info.name_array.name (ganav_loop)
 872                     = OPTIONS.GENERAL_REPORT.NAME (ganav_loop);
 873 %skip(1);
 874           end;
 875 %skip(1);
 876           call value_$list (value_seg_ptr, PERMANENT, match_info_ptr,
 877                names_and_values_area_ptr, value_list_info_ptr, code);
 878           if code ^= 0
 879           then call ssu_$abort_line (sci_ptr, code,
 880                "^/While trying to get the report option names and values.");
 881 %skip(1);
 882           general_report_names_and_values_info_ptr = value_list_info_ptr;
 883 %page;
 884           /* Get the names and values for the general and specific column options. */
 885 %skip(1);
 886           if valid_selection_expression
 887           then do;
 888 %skip(1);
 889                alloc_name_count = NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
 890                alloc_max_name_len = LONGEST_GENERAL_COLUMN_OPTION_NAME_LENGTH;
 891                allocate match_info in (names_and_values_area)
 892                     set (match_info_ptr);
 893                match_info.version = match_info_version_1;
 894 %skip(1);
 895                do ganav_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
 896 %skip(1);
 897                     match_info.name_array.exclude_sw (ganav_loop) = OFF;
 898                     match_info.name_array.regexp_sw (ganav_loop) = OFF;
 899                     match_info.name_array.name (ganav_loop)
 900                          = OPTIONS.GENERAL_COLUMN.NAME (ganav_loop);
 901 %skip(1);
 902                end;
 903 %skip(1);
 904                call value_$list (value_seg_ptr, PERMANENT, match_info_ptr,
 905                     names_and_values_area_ptr, value_list_info_ptr, code);
 906                if code ^= 0
 907                then call ssu_$abort_line (sci_ptr, code,
 908                     "^/While trying to get the general column option names and values.");
 909 %skip(1);
 910                general_columns_names_and_values_info_ptr = value_list_info_ptr;
 911 %skip(1);
 912                alloc_name_count = NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
 913                alloc_max_name_len = LONGEST_SPECIFIC_COLUMN_OPTION_NAME_LENGTH
 914                     + length (BLANK) + length (STAR_DOT_STAR_STAR);
 915                allocate match_info in (names_and_values_area)
 916                     set (match_info_ptr);
 917                match_info.version = match_info_version_1;
 918 %skip(1);
 919                do ganav_loop = 1 to NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
 920 %skip(1);
 921                     match_info.name_array.exclude_sw (ganav_loop) = OFF;
 922                     match_info.name_array.regexp_sw (ganav_loop) = OFF;
 923                     match_info.name_array.name (ganav_loop)
 924                          = OPTIONS.SPECIFIC_COLUMN.NAME (ganav_loop)
 925                          || BLANK || STAR_DOT_STAR_STAR;
 926 %skip(1);
 927                end;
 928 %skip(1);
 929                call value_$list (value_seg_ptr, PERMANENT, match_info_ptr,
 930                     names_and_values_area_ptr, value_list_info_ptr, code);
 931                if code ^= 0
 932                then call ssu_$abort_line (sci_ptr, code,
 933                     "While trying to get the specific column option names and values.");
 934 %skip(1);
 935                specific_columns_names_and_values_info_ptr = value_list_info_ptr;
 936 %skip(1);
 937           end;
 938 %skip(1);
 939           /* Set the number of options we have and the length of them. */
 940 %skip(1);
 941           if valid_selection_expression
 942           then size_of_names_and_values =
 943                general_report_names_and_values_info_ptr -> value_list_info.chars_len
 944                + general_columns_names_and_values_info_ptr -> value_list_info.chars_len
 945                + specific_columns_names_and_values_info_ptr -> value_list_info.chars_len;
 946           else size_of_names_and_values =
 947                general_report_names_and_values_info_ptr -> value_list_info.chars_len;
 948           allocate names_and_values in (names_and_values_area)
 949                set (names_and_values_ptr);
 950 %skip(1);
 951           if valid_selection_expression
 952           then no_of_names_and_values =
 953                general_report_names_and_values_info_ptr -> value_list_info.pair_count
 954                + general_columns_names_and_values_info_ptr -> value_list_info.pair_count
 955                + specific_columns_names_and_values_info_ptr -> value_list_info.pair_count;
 956           else no_of_names_and_values =
 957                general_report_names_and_values_info_ptr -> value_list_info.pair_count;
 958           allocate name_value_info in (names_and_values_area)
 959                set (names_and_values_info_ptr);
 960 %skip(1);
 961           /* Move the general report options and their lengths and index
 962              into the callers table. */
 963 %skip(1);
 964           value_list_info_ptr = general_report_names_and_values_info_ptr;
 965           substr (names_and_values, 1, value_list_info.chars_len)
 966                = value_list_info.chars;
 967 %skip(1);
 968           do ganav_loop = 1 to NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
 969 %skip(1);
 970                name_value_info.name.index (ganav_loop) =
 971                     value_list_info.pairs.name_index (ganav_loop);
 972                name_value_info.name.length (ganav_loop) =
 973                     value_list_info.pairs.name_len (ganav_loop);
 974                name_value_info.value.index (ganav_loop) =
 975                     value_list_info.pairs.value_index (ganav_loop);
 976                name_value_info.value.length (ganav_loop) =
 977                     value_list_info.pairs.value_len (ganav_loop);
 978 %skip(1);
 979           end;
 980 %skip(1);
 981           if ^valid_selection_expression
 982           then return;
 983 %skip(1);
 984           /* Move the general and specific column options and their lengths
 985              and index into the callers table. */
 986 %skip(1);
 987           ganav_no_of_chars_already_done = value_list_info.chars_len;
 988           ganav_inner_loop = NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE + 1;
 989           value_list_info_ptr = general_columns_names_and_values_info_ptr;
 990           substr (names_and_values, ganav_no_of_chars_already_done + 1,
 991                value_list_info.chars_len) = value_list_info.chars;
 992 %skip(1);
 993           do ganav_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
 994 %skip(1);
 995                name_value_info.name.index (ganav_inner_loop) =
 996                     value_list_info.pairs.name_index (ganav_loop)
 997                     + ganav_no_of_chars_already_done;
 998                name_value_info.name.length (ganav_inner_loop) =
 999                     value_list_info.pairs.name_len (ganav_loop);
1000 %skip(1);
1001                name_value_info.value.index (ganav_inner_loop) =
1002                     value_list_info.pairs.value_index (ganav_loop)
1003                     + ganav_no_of_chars_already_done;
1004                name_value_info.value.length (ganav_inner_loop) =
1005                     value_list_info.pairs.value_len (ganav_loop);
1006                ganav_inner_loop = ganav_inner_loop + 1;
1007 %skip(1);
1008           end;
1009 %skip(1);
1010           ganav_no_of_chars_already_done =
1011                ganav_no_of_chars_already_done + value_list_info.chars_len;
1012           value_list_info_ptr = specific_columns_names_and_values_info_ptr;
1013           substr (names_and_values, ganav_no_of_chars_already_done + 1,
1014                value_list_info.chars_len) = value_list_info.chars;
1015 %skip(1);
1016           ganav_loop_limit = NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE
1017                * table_info.column_count;
1018 %skip(1);
1019           do ganav_loop = 1 to ganav_loop_limit;
1020 %skip(1);
1021                name_value_info.name.index (ganav_inner_loop) =
1022                     value_list_info.pairs.name_index (ganav_loop)
1023                     + ganav_no_of_chars_already_done;
1024                name_value_info.name.length (ganav_inner_loop) =
1025                     value_list_info.pairs.name_len (ganav_loop);
1026 %skip(1);
1027                name_value_info.value.index (ganav_inner_loop) =
1028                     value_list_info.pairs.value_index (ganav_loop)
1029                     + ganav_no_of_chars_already_done;
1030                name_value_info.value.length (ganav_inner_loop) =
1031                     value_list_info.pairs.value_len (ganav_loop);
1032                ganav_inner_loop = ganav_inner_loop + 1;
1033 %skip(1);
1034           end;
1035 %skip(1);
1036           return;
1037 %skip(1);
1038      end get_all_names_and_values;
1039 %page;
1040 get_general_column_default_value: proc (
1041 
1042           ggcdv_option_name_parm, /* input: name of option */
1043           ggcdv_option_value_parm /* output: default value for above option */
1044                                       );
1045 %skip(3);
1046 /*
1047 
1048      When this proc is called it expects ggcdv_option_name_parm to contain
1049      the name of the option that the default should be generated for.  It
1050      sets ggcdv_option_value_parm to this default value or "ERROR" if things
1051      don't work out well.
1052 
1053 */
1054 %skip(1);
1055 dcl ggcdv_loop fixed bin;
1056 dcl ggcdv_option_name_parm char (*) varying parm;
1057 dcl ggcdv_option_value_parm char (*) varying parm;
1058 %skip(1);
1059           if ggcdv_option_name_parm
1060                = OPTIONS.GENERAL_COLUMN.NAME (INDEX_FOR_COLUMN_ORDER)
1061           then do;
1062                ggcdv_option_value_parm = table_info.columns.column_name (1);
1063                if number_of_defined_columns = 1
1064                then return;
1065                do ggcdv_loop = 2 to number_of_defined_columns;
1066                     ggcdv_option_value_parm = ggcdv_option_value_parm || BLANK
1067                          || table_info.columns.column_name (ggcdv_loop);
1068                end;
1069           end;
1070           else ggcdv_option_value_parm = "ERROR";
1071 %skip(1);
1072           return;
1073 %skip(1);
1074      end get_general_column_default_value;
1075 %page;
1076 get_specific_column_default_value: proc (
1077 
1078           gscdv_option_name_parm,       /* input: option name */
1079           gscdv_option_identifier_parm, /* input: identifier for name */
1080           gscdv_option_value_parm       /* output: value for the option */
1081                                         );
1082 %skip(3);
1083 /*
1084 
1085      This proc gets the default value of any given column.  When called, it
1086      expects that gscdv_option_name_parm contains a valid option name and
1087      gscdv_option_identifier_parm contains a valid option identifier which has
1088      been normalized into a column name.  It places the default value in
1089      gscdv_option_value_parm.  This proc expects that table_info is available
1090      and up to date, which means there has to be a set of columns defined.
1091      Error conditions are handled by setting the value "ERROR".  There should
1092      never be any error conditions unless this proc is used incorrectly.
1093 
1094 */
1095 %skip(1);
1096 dcl gscdv_column_option_number fixed bin;
1097 dcl gscdv_column_type fixed bin (6) unsigned unaligned;
1098 dcl gscdv_hit bit (1) aligned;
1099 dcl gscdv_loop fixed bin;
1100 dcl gscdv_option_identifier_parm char (*) varying parm;
1101 dcl gscdv_option_name_parm char (*) varying parm;
1102 dcl gscdv_option_value_parm char (*) varying parm;
1103 %skip(1);
1104           gscdv_hit = OFF;
1105 %skip(1);
1106           do gscdv_loop = 1 to number_of_defined_columns while (^gscdv_hit);
1107                if table_info.columns.column_name (gscdv_loop)
1108                     = gscdv_option_identifier_parm
1109                then do;
1110                     gscdv_hit = ON;
1111                     gscdv_column_option_number = gscdv_loop;
1112                end;
1113           end;
1114 %skip(1);
1115           if ^gscdv_hit
1116           then do;
1117                gscdv_option_value_parm = "ERROR";
1118                return;
1119           end;
1120 %page;
1121           if gscdv_option_name_parm
1122                = OPTIONS.SPECIFIC_COLUMN.NAME (INDEX_FOR_ALIGNMENT)
1123           then do;
1124                desc_ptr = addr (table_info.columns.column_data_type (
1125                     gscdv_column_option_number));
1126                gscdv_column_type = descriptor.type;
1127                if (gscdv_column_type >= 1 & gscdv_column_type <= 8)             /* NUMERIC */
1128                | (gscdv_column_type = 33 | gscdv_column_type = 34)
1129                then gscdv_option_value_parm = RIGHT;
1130                else if (gscdv_column_type >= 9 & gscdv_column_type <= 12)       /* DECIMAL */
1131                     | (gscdv_column_type = 29 | gscdv_column_type = 30)
1132                     | (gscdv_column_type = 35 | gscdv_column_type = 36)
1133                     | (gscdv_column_type >= 38 & gscdv_column_type <= 46)
1134                     then if fixed (descriptor.size.scale, 17, 0) > 0
1135                          then gscdv_option_value_parm = DECIMAL || BLANK || ltrim (char
1136                               (table_info.columns.column_length (gscdv_column_option_number)
1137                               - fixed (descriptor.size.scale, 17, 0)));
1138                          else gscdv_option_value_parm = RIGHT;
1139                     else if (gscdv_column_type >= 19 & gscdv_column_type <= 22) /* CHAR OR BIT */
1140                          then gscdv_option_value_parm = LEFT;
1141                          else call ssu_$abort_line (sci_ptr, 0,
1142                          "The table information described an unsupported data type.^/The data descriptor was ^d.",
1143                          gscdv_column_type);
1144           end;
1145           else if gscdv_option_name_parm
1146                = OPTIONS.SPECIFIC_COLUMN.NAME (INDEX_FOR_TITLE)
1147                then gscdv_option_value_parm
1148                = table_info.columns.column_name (gscdv_column_option_number);
1149                else if gscdv_option_name_parm
1150                     = OPTIONS.SPECIFIC_COLUMN.NAME (INDEX_FOR_WIDTH)
1151                     then gscdv_option_value_parm = ltrim (char
1152                          (table_info.columns.column_length (gscdv_column_option_number)));
1153                     else gscdv_option_value_parm = "ERROR";
1154 %skip(1);
1155      end get_specific_column_default_value;
1156 %page;
1157 get_named_values: proc (gnv_code_parm);
1158 %skip(3);
1159 /*
1160 
1161      This proc is called by the get_named entrypoint to get the names and
1162      values which match a set of option names and identifiers supplied by the
1163      caller of the get_named entry.  The option name can be a short or long
1164      name.  The column/option identifier provided can be a column name,
1165      column number, or star name.  The star names can only match column
1166      names; star name matching of column numbers is not attempted.
1167      Unfortunately, value_$list has an ugly little quirk of not returning the
1168      code error_table_$nomatch when star names result in no match, if any
1169      other name in the match_info structure does get a match.  So we have to
1170      pre-match star names or else user specified star names that don't get a
1171      match could well go unnoticed.
1172 
1173 */
1174 %skip(1);
1175 dcl gnv_code_parm fixed bin (35) parm;
1176 dcl gnv_current_star_name fixed bin;
1177 dcl gnv_inner_loop fixed bin;
1178 dcl gnv_loop fixed bin;
1179 dcl gnv_match_info_index fixed bin;
1180 dcl gnv_number_of_matches fixed bin;
1181 %skip(1);
1182           gnv_code_parm = 0;
1183 %skip(1);
1184           alloc_name_count = no_of_options_in_name_table;
1185           if valid_selection_expression
1186           then alloc_max_name_len = MAXIMUM_NORMALIZED_OPTION_NAME_LENGTH;
1187           else alloc_max_name_len = MAXIMUM_OPTION_NAME_LENGTH;
1188 %skip(1);
1189           star_name_info_ptr = names_and_values_temp_seg_ptr;
1190           star_name_info.maximum_number_of_star_names
1191                = no_of_options_in_name_table;
1192           star_name_info.star_name_map (*) = OFF;
1193           star_name_info.number_of_star_names = 1;
1194 %skip(1);
1195           allocate column_map in (names_and_values_area) set (column_map_ptr);
1196 %skip(1);
1197           do gnv_loop = 1 to no_of_options_in_name_table;
1198 %skip(1);
1199                call normalize_option_name (
1200                     option_name_table.the_name (gnv_loop),
1201                     option_name_table.the_identifier (gnv_loop),
1202                     option_type, option_table_index,
1203                     normalized_option_name, gnv_code_parm);
1204                if gnv_code_parm = 0
1205                then if option_type = SPECIFIC_COLUMN_OPTION
1206                     then option_name_table.the_identifier (gnv_loop)
1207                          = after (normalized_option_name, BLANK);
1208                     else option_name_table.the_identifier (gnv_loop) = "";
1209                else if gnv_code_parm = error_table_$nostars
1210                     then do;
1211                          call match_column_names (
1212                               option_name_table.the_identifier (gnv_loop),
1213                               column_map, gnv_number_of_matches, gnv_code_parm);
1214                          if gnv_code_parm ^= 0
1215                          then call ssu_$abort_line (sci_ptr, gnv_code_parm,
1216                               "^/The column identifier ^a did not match any column names.",
1217                               option_name_table.the_identifier (gnv_loop));
1218                          else;
1219                          if gnv_number_of_matches ^= 1
1220                          then alloc_name_count = alloc_name_count
1221                               + gnv_number_of_matches - 1;
1222                          star_name_info.star_name_map (gnv_loop) = ON;
1223                          star_name_info.column_maps_info (
1224                               star_name_info.number_of_star_names)
1225                               .number_of_matches = gnv_number_of_matches;
1226                          star_name_info.column_maps_info (
1227                               star_name_info.number_of_star_names)
1228                               .column_bit_map (*) = column_map (*);
1229                          star_name_info.number_of_star_names
1230                               = star_name_info.number_of_star_names + 1;
1231                     end;
1232                     else if gnv_code_parm = linus_error_$bad_option_name
1233                          then call ssu_$abort_line (sci_ptr, gnv_code_parm,
1234                               "^/^a is not a valid option name.",
1235                               option_name_table.the_name (gnv_loop));
1236                          else if gnv_code_parm = linus_error_$bad_option_identifier
1237                               then call ssu_$abort_line (sci_ptr, gnv_code_parm,
1238                                    "^/^a is not a valid option identifier for ^a.",
1239                                    option_name_table.the_identifier (gnv_loop),
1240                                    option_name_table.the_name (gnv_loop));
1241                               else call ssu_$abort_line (sci_ptr, gnv_code_parm);
1242 %skip(1);
1243           end;
1244 %skip(1);
1245           star_name_info.number_of_star_names
1246                = star_name_info.number_of_star_names - 1;
1247 %skip(1);
1248           allocate match_info in (names_and_values_area) set (match_info_ptr);
1249           match_info.version = match_info_version_1;
1250 %skip(1);
1251           gnv_match_info_index = 1;
1252           gnv_current_star_name = 1;
1253           do gnv_loop = 1 to no_of_options_in_name_table;
1254 %skip(1);
1255                match_info.name_array.exclude_sw (gnv_match_info_index) = OFF;
1256                match_info.name_array.regexp_sw (gnv_match_info_index) = OFF;
1257 %skip(1);
1258                if ^star_name_info.star_name_map (gnv_loop)
1259                then do;
1260                     if option_name_table.the_identifier (gnv_loop) = ""
1261                     then match_info.name_array.name (gnv_match_info_index)
1262                          = option_name_table.the_name (gnv_loop);
1263                     else match_info.name_array.name (gnv_match_info_index)
1264                          = option_name_table.the_name (gnv_loop)
1265                          || BLANK || option_name_table.the_identifier (gnv_loop);
1266                     gnv_match_info_index = gnv_match_info_index + 1;
1267                end;
1268                else do;
1269                     column_map_ptr = addr (star_name_info
1270                          .column_maps_info (gnv_current_star_name)
1271                          .column_bit_map (1));
1272                     do gnv_inner_loop = 1 to number_of_defined_columns;
1273                          if column_map (gnv_inner_loop)
1274                          then do;
1275                               match_info.name_array.name (gnv_match_info_index)
1276                                    = option_name_table.the_name (gnv_loop)
1277                                    || BLANK || table_info.columns.column_name (gnv_inner_loop);
1278                               gnv_match_info_index = gnv_match_info_index + 1;
1279                          end;
1280                     end;
1281                     gnv_current_star_name = gnv_current_star_name + 1;
1282                end;
1283 %skip(1);
1284           end;
1285 %skip(1);
1286           call value_$list (value_seg_ptr, PERMANENT, match_info_ptr,
1287                names_and_values_area_ptr, value_list_info_ptr, code);
1288           if code ^= 0
1289           then call ssu_$abort_line (sci_ptr, code,
1290                "^/Unable to get the values of the specified format options.");
1291           else;
1292 %skip(1);
1293           no_of_names_and_values = value_list_info.pair_count;
1294           allocate name_value_info in (names_and_values_area)
1295                set (names_and_values_info_ptr);
1296 %skip(1);
1297           do gnv_loop = 1 to no_of_names_and_values;
1298                name_value_info.name.length (gnv_loop)
1299                     = value_list_info.pairs.name_len (gnv_loop);
1300                name_value_info.name.index (gnv_loop)
1301                     = value_list_info.pairs.name_index (gnv_loop);
1302                name_value_info.value.length (gnv_loop)
1303                     = value_list_info.pairs.value_len (gnv_loop);
1304                name_value_info.value.index (gnv_loop)
1305                     = value_list_info.pairs.value_index (gnv_loop);
1306           end;
1307 %skip(1);
1308           size_of_names_and_values = value_list_info.chars_len;
1309           allocate names_and_values in (names_and_values_area)
1310                set (names_and_values_ptr);
1311           names_and_values = value_list_info.chars;
1312 %skip(1);
1313           return;
1314 %skip(1);
1315      end get_named_values;
1316 %page;
1317 housekeeping: proc;
1318 %skip(3);
1319 /*
1320 
1321      This procedure is called to set up various automatic versions of some of
1322      some things we will need to run this subroutine, and to make sure
1323      linus_table$info has been called.
1324 
1325 */
1326 %skip(1);
1327           sci_ptr = lcb.subsystem_control_info_ptr;
1328           report_cip = lcb.report_control_info_ptr;
1329           value_seg_ptr = report_control_info.value_seg_ptr;
1330           names_and_values_area_ptr = report_control_info.name_value_area_ptr;
1331           names_and_values_temp_seg_ptr = report_control_info.name_value_temp_seg_ptr;
1332 %skip(1);
1333           call linus_table$info (lcb_ptr, table_ip, code);
1334           if code ^= 0
1335           then if code ^= linus_error_$no_lila_expr_processed
1336                then call ssu_$abort_line (sci_ptr, code,
1337                     "While trying to get table information.");
1338                else do;
1339                     valid_selection_expression = OFF;
1340                     number_of_defined_columns = 0;
1341                end;
1342           else do;
1343                valid_selection_expression = ON;
1344                number_of_defined_columns = table_info.column_count;
1345           end;
1346 %skip(1);
1347           return;
1348 %skip(1);
1349      end housekeeping;
1350 %page;
1351 load_value_seg_with_column_defaults: proc;
1352 %skip(3);
1353 /*
1354 
1355      This procedure is called to load all of the column default values into
1356      the value seg.  It expects that table_info has been set and is current
1357      (which means there must be a valid selection expression available.)
1358 
1359 */
1360 %skip(1);
1361 dcl lvswcd_inner_loop fixed bin;
1362 dcl lvswcd_loop fixed bin;
1363 %skip(1);
1364           do lvswcd_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
1365 %skip(1);
1366                lvswcd_option_name = OPTIONS.GENERAL_COLUMN.NAME (lvswcd_loop);
1367                lvswcd_option_value = OPTIONS.GENERAL_COLUMN.VALUE (lvswcd_loop);
1368                if length (lvswcd_option_value) > 0
1369                then if substr (lvswcd_option_value, 1, 1) = LEFT_BRACKET
1370                     then do;
1371                          call get_general_column_default_value (
1372                               lvswcd_option_name, lvswcd_option_value);
1373                          if lvswcd_option_value = "ERROR"
1374                          then call ssu_$abort_line (sci_ptr, 0,
1375                               "While trying to get the default value for ^a.",
1376                               lvswcd_option_name);
1377                          else;
1378                     end;
1379                     else;
1380                else;
1381 %skip(1);
1382                call value_$set (value_seg_ptr, PERMANENT, lvswcd_option_name,
1383                     lvswcd_option_value, returned_option_value, code);
1384                if code ^= 0
1385                then call ssu_$abort_line (sci_ptr, code,
1386                     "While trying to set the value ^a for ^a.",
1387                     lvswcd_option_value, lvswcd_option_name);
1388 %skip(1);
1389           end;
1390 %page;
1391           do lvswcd_loop = 1 to NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
1392 %skip(1);
1393                lvswcd_option_name = OPTIONS.SPECIFIC_COLUMN.NAME (lvswcd_loop);
1394 %skip(1);
1395                do lvswcd_inner_loop = 1 to number_of_defined_columns;
1396 %skip(1);
1397                     lvswcd_option_identifier
1398                          = table_info.columns.column_name (lvswcd_inner_loop);
1399                     normalized_option_name
1400                          = lvswcd_option_name || BLANK || lvswcd_option_identifier;
1401                     lvswcd_option_value = OPTIONS.SPECIFIC_COLUMN.VALUE (lvswcd_loop);
1402                     if length (lvswcd_option_value) > 0
1403                     then if substr (lvswcd_option_value, 1, 1) = LEFT_BRACKET
1404                          then do;
1405                               call get_specific_column_default_value (
1406                                    lvswcd_option_name, lvswcd_option_identifier,
1407                                    lvswcd_option_value);
1408                               if lvswcd_option_value = "ERROR"
1409                               then call ssu_$abort_line (sci_ptr, 0,
1410                                    "While trying to get the default value for ^a.",
1411                                    normalized_option_name);
1412                               else;
1413                          end;
1414                          else;
1415                     else;
1416 %skip(1);
1417                     call value_$set (value_seg_ptr, PERMANENT,
1418                          normalized_option_name, lvswcd_option_value,
1419                          returned_option_value, code);
1420                     if code ^= 0
1421                     then call ssu_$abort_line (sci_ptr, code,
1422                          "While trying to set the value ^a for ^a.",
1423                          lvswcd_option_value, normalized_option_name);
1424 %skip(1);
1425                end;
1426 %skip(1);
1427           end;
1428 %skip(1);
1429           report_control_info.options_identifier
1430                = report_control_info.options_identifier + 1;
1431           report_control_info.selection_expression_identifier
1432                = lcb.selection_expression_identifier;
1433           report_control_info.format_options_flags
1434                .general_column_default_value (*) = ON;
1435 %skip(1);
1436           return;
1437 %skip(1);
1438      end load_value_seg_with_column_defaults;
1439 %page;
1440 load_value_seg_with_report_defaults: proc;
1441 %skip(3);
1442 /*
1443 
1444      This proc is called to load the value seg with the general report option
1445      defaults from the OPTIONS.GENERAL_REPORT table found in the include file
1446      linus_format_options.incl.pl1.
1447 
1448 */
1449 %skip(1);
1450 dcl lvswrd_loop fixed bin;
1451 %skip(1);
1452           do lvswrd_loop = 1 to NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
1453 %skip(1);
1454                call value_$set (value_seg_ptr, PERMANENT,
1455                     OPTIONS.GENERAL_REPORT.NAME (lvswrd_loop),
1456                     OPTIONS.GENERAL_REPORT.VALUE (lvswrd_loop),
1457                     returned_option_value, code);
1458                if code ^= 0
1459                then call ssu_$abort_line (sci_ptr, code,
1460                     "While trying to set the value ^a for ^a.",
1461                     OPTIONS.GENERAL_REPORT.VALUE (lvswrd_loop),
1462                     OPTIONS.GENERAL_REPORT.NAME (lvswrd_loop));
1463 %skip(1);
1464           end;
1465 %skip(1);
1466           report_control_info.options_identifier =
1467                report_control_info.options_identifier + 1;
1468           report_control_info.format_options_flags.general_report_default_value (*) = ON;
1469 %skip(1);
1470           return;
1471 %skip(1);
1472      end load_value_seg_with_report_defaults;
1473 %page;
1474 lookup_option_number: proc (
1475 
1476           lon_option_name_parm,  /* input: option name to look up */
1477           lon_option_type_parm,  /* output: the table to index into */
1478           lon_option_index_parm  /* output: the index into the table */
1479                            );
1480 %skip(1);
1481 /*
1482 
1483      This proc looks up option names from the three tables of option names.
1484      lon_option_name_parm is expected to contain the name of the option.
1485      lon_option_type_parm is set to indicate whether it is a general report,
1486      general column, or specific column option. lon_option_index_parm is
1487      the index into the appropriate table so the caller can obtain its value.
1488 
1489 */
1490 %skip(1);
1491 dcl lon_loop fixed bin;
1492 dcl lon_option_name_parm char (*) varying parm;
1493 dcl lon_option_type_parm fixed bin parm;
1494 dcl lon_option_index_parm fixed bin parm;
1495 %skip(1);
1496           lon_option_type_parm = 0;
1497 %skip(1);
1498           lon_option_index_parm = lookup_general_report_option ();
1499           if lon_option_index_parm ^= 0
1500           then do;
1501                lon_option_type_parm = GENERAL_REPORT_OPTION;
1502                return;
1503           end;
1504 %skip(1);
1505           lon_option_index_parm = lookup_general_column_option ();
1506           if lon_option_index_parm ^= 0
1507           then do;
1508                lon_option_type_parm = GENERAL_COLUMN_OPTION;
1509                return;
1510           end;
1511 %skip(1);
1512           lon_option_index_parm = lookup_specific_column_option ();
1513           if lon_option_index_parm ^= 0
1514           then lon_option_type_parm = SPECIFIC_COLUMN_OPTION;
1515 %skip(1);
1516           return;
1517 %page;
1518 lookup_general_column_option: proc () returns (fixed bin);
1519 %skip(1);
1520           /* Look up the option name from the general column names table. */
1521 %skip(1);
1522           do lon_loop = 1 to NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE;
1523                if lon_option_name_parm = OPTIONS.GENERAL_COLUMN.NAME (lon_loop)
1524                then return (lon_loop);
1525           end;
1526 %skip(1);
1527           return (0);
1528 %skip(1);
1529      end lookup_general_column_option;
1530 %skip(3);
1531 lookup_general_report_option: proc () returns (fixed bin);
1532 %skip(1);
1533           /* Look up the option name from the general report names table. */
1534 %skip(1);
1535           do lon_loop = 1 to NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE;
1536                if lon_option_name_parm = OPTIONS.GENERAL_REPORT.NAME (lon_loop)
1537                then return (lon_loop);
1538           end;
1539 %skip(1);
1540           return (0);
1541 %skip(1);
1542      end lookup_general_report_option;
1543 %skip(3);
1544 lookup_specific_column_option: proc () returns (fixed bin);
1545 %skip(1);
1546           /* Look up the option name from the specific column names table. */
1547 %skip(1);
1548           do lon_loop = 1 to NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE;
1549                if lon_option_name_parm = OPTIONS.SPECIFIC_COLUMN.NAME (lon_loop)
1550                then return (lon_loop);
1551           end;
1552 %skip(1);
1553           return (0);
1554 %skip(1);
1555      end lookup_specific_column_option;
1556 %skip(1);
1557      end lookup_option_number;
1558 %page;
1559 match_column_names: proc (
1560 
1561           mcn_star_name_parm,         /* input: star name to match */
1562           mcn_column_map_parm,        /* input/output: array of match bits */
1563           mcn_number_of_matches_parm, /* output: number of matches */
1564           mcn_code_parm               /* output: success or failure */
1565                          );
1566 %skip(3);
1567 /*
1568 
1569      This proc is called with a star name to determine which columns match
1570      it. The variable mcn_star_name_parm contains the variable which is used
1571      to try to get a match. The array mcn_column_map_parm contains one bit
1572      for each defined column. Each column that matches the star name has its
1573      corresponding bit turned on, and the variable mcn_number_of_matches_parm
1574      contains the number of columns that matched. The variable mcn_code_parm
1575      is set to reflect any problems encountered.
1576 
1577 */
1578 %skip(1);
1579 dcl mcn_code_parm fixed bin (35) parm;
1580 dcl mcn_loop fixed bin;
1581 dcl mcn_column_map_parm (*) bit (1) parm;
1582 dcl mcn_number_of_matches fixed bin;
1583 dcl mcn_number_of_matches_parm fixed bin parm;
1584 dcl mcn_star_name_parm char (*) varying parm;
1585 %skip(1);
1586           mcn_column_map_parm (*) = OFF;
1587           mcn_number_of_matches_parm = 0;
1588           mcn_code_parm = 0;
1589 %skip(1);
1590           if hbound (mcn_column_map_parm, 1) ^= number_of_defined_columns
1591           then call ssu_$abort_line (sci_ptr, 0, "^a ^a^/^a",
1592                "Invalid use of match_column_names by ", me,
1593                "The match table was not equal to the number of defined columns.");
1594           else;
1595 %skip(1);
1596           mcn_number_of_matches = 0;
1597           do mcn_loop = 1 to number_of_defined_columns;
1598                call match_star_name_ (
1599                     (table_info.columns.column_name (mcn_loop)),
1600                     (mcn_star_name_parm), mcn_code_parm);
1601                if mcn_code_parm = 0
1602                then do;
1603                     mcn_column_map_parm (mcn_loop) = ON;
1604                     mcn_number_of_matches = mcn_number_of_matches + 1;
1605                end;
1606                else if mcn_code_parm ^= error_table_$nomatch
1607                     then return;
1608                     else;
1609           end;
1610 %skip(1);
1611           if mcn_number_of_matches ^= 0
1612           then do;
1613                mcn_number_of_matches_parm = mcn_number_of_matches;
1614                mcn_code_parm = 0;
1615           end;
1616           else;
1617 %skip(1);
1618           return;
1619 %skip(1);
1620      end match_column_names;
1621 %page;
1622 normalize_option_name: proc (
1623 
1624           non_option_name_parm,            /* input: the option name */
1625           non_option_identifier_parm,      /* input: the column name or number */
1626           non_option_type_parm,            /* output: the type of option */
1627           non_option_table_index_parm,     /* output: index into options table */
1628           non_normalized_option_name_parm, /* output: the option and column name */
1629           non_code_parm                    /* output: success or failure */
1630                             );
1631 %skip(1);
1632 /*
1633 
1634      This proc is called to set general purpose info about the option currently
1635      being dealt with.  It expects non_option_name_parm to contain a name
1636      which can be used to determine whether or not it requires an identifier.
1637      The option_name must already have been expanded into a long name (see
1638      the "check_name" entry for expansion of option names).  If an
1639      identifier is needed, it expects non_option_identifier_parm to contain
1640      it.  The identifier can be the name of a column or the position of the
1641      column in the LILA select.  If the identifier is a star name or invalid,
1642      non_code_parm is set.  It places the option name into
1643      non_normalized_option_name_parm if a column identifier isn't needed, and
1644      the option name and column name in it when an identifier is needed.
1645      When errors occur normalized_option_name is set to "", except for
1646      starnames.  The variable non_option_type_parm is set to flag whether it
1647      is a general report, general column, or specific column option.  The
1648      variable non_option_table_index_parm is set so the caller can index into
1649      the appropriate options table.
1650 
1651 */
1652 %skip(1);
1653 dcl non_code_parm fixed bin (35) parm;
1654 dcl non_column_option_number fixed bin;
1655 dcl non_loop fixed bin;
1656 dcl non_normalized_option_name_parm char (*) varying parm;
1657 dcl non_option_identifier_parm char (*) varying parm;
1658 dcl non_option_name_parm char (*) varying parm;
1659 dcl non_option_table_index_parm fixed bin parm;
1660 dcl non_option_type_parm fixed bin parm;
1661 %skip(3);
1662           non_normalized_option_name_parm = "";
1663           non_code_parm = 0;
1664 %skip(1);
1665           call lookup_option_number (non_option_name_parm,
1666                non_option_type_parm, non_option_table_index_parm);
1667           if non_option_table_index_parm = 0
1668           then do;
1669                non_code_parm = linus_error_$bad_option_name;
1670                return;
1671           end;
1672 %skip(1);
1673           if (non_option_type_parm = GENERAL_COLUMN_OPTION
1674           | non_option_type_parm = SPECIFIC_COLUMN_OPTION)
1675           & (^valid_selection_expression)
1676           then do;
1677                code = linus_error_$no_lila_expr_processed;
1678                return;
1679           end;
1680           else;
1681 %skip(1);
1682           if non_option_type_parm = GENERAL_REPORT_OPTION
1683           | non_option_type_parm = GENERAL_COLUMN_OPTION
1684           then do;
1685                non_normalized_option_name_parm = non_option_name_parm;
1686                return;
1687           end;
1688 %skip(1);
1689           if search (non_option_identifier_parm, STAR_OR_QUESTION_MARK) ^= 0
1690           then do;
1691                non_code_parm = error_table_$nostars;
1692                non_normalized_option_name_parm = non_option_name_parm
1693                     || BLANK || non_option_identifier_parm;
1694                return;
1695           end;
1696 %skip(1);
1697           if verify (non_option_identifier_parm, DIGITS) = 0
1698           then do;
1699                non_column_option_number = convert (non_column_option_number,
1700                     non_option_identifier_parm);
1701                if non_column_option_number < 1
1702                | non_column_option_number > number_of_defined_columns
1703                then non_code_parm = linus_error_$bad_option_identifier;
1704                else non_normalized_option_name_parm =
1705                     non_option_name_parm || BLANK
1706                     || table_info.columns.column_name (non_column_option_number);
1707                return;
1708           end;
1709 %skip(1);
1710           do non_loop = 1 to number_of_defined_columns;
1711                if non_option_identifier_parm = table_info.columns.column_name (non_loop)
1712                then do;
1713                     non_normalized_option_name_parm =
1714                          non_option_name_parm || BLANK || non_option_identifier_parm;
1715                     return;
1716                end;
1717           end;
1718 %skip(1);
1719           non_code_parm = linus_error_$bad_option_identifier;
1720 %skip(1);
1721           return;
1722 %skip(1);
1723      end normalize_option_name;
1724 %page;
1725 release_temp_segment: proc (
1726 
1727           rts_ptr_parm        /* input: ptr to temp segment */
1728                                     );
1729 %skip(3);
1730 dcl rts_code fixed bin (35);
1731 dcl rts_ptr_parm ptr parm;
1732 %skip(1);
1733           call release_temp_segment_ (me, rts_ptr_parm, rts_code);
1734           if rts_code ^= 0
1735           then call ssu_$print_message (sci_ptr, rts_code,
1736                "While trying to release the temporary segment pointed to by ^/^p.", rts_ptr_parm);
1737 %skip(1);
1738           return;
1739 %skip(1);
1740      end release_temp_segment;
1741 %page;
1742 set_the_values: proc (
1743 
1744           stv_option_name_parm,            /* input: option name */
1745           stv_option_identifier_parm,      /* input: column identifier */
1746           stv_option_value_parm,           /* input: option value */
1747           stv_system_default_parm,         /* input: on means yes */
1748           stv_code_parm                    /* output: success or failure */
1749                        );
1750 %skip(1);
1751 /*
1752 
1753      This proc is called to set the value of a format option. If the value
1754      is a star name then the value is set for every name that matches the
1755      star name. The internal proc set_value sets the value. For a normal
1756      column name, it is called once with normalized_option_name used for
1757      the set operation. For star names, normalized_option_name is changed
1758      before each call with a column name that matched the star name.
1759 
1760 */
1761 %skip(1);
1762 dcl stv_code_parm fixed bin (35) parm;
1763 dcl stv_loop fixed bin;
1764 dcl stv_number_of_matches fixed bin;
1765 dcl stv_option_name_parm char (*) varying parm;
1766 dcl stv_option_identifier_parm char (*) varying parm;
1767 dcl stv_option_value_parm char (*) varying parm;
1768 dcl stv_system_default_parm bit (1) aligned parm;
1769 dcl stv_value_has_been_tested bit (1) aligned;
1770 %skip(1);
1771           call normalize_option_name (stv_option_name_parm,
1772                stv_option_identifier_parm, option_type, option_table_index,
1773                normalized_option_name, stv_code_parm);
1774           if stv_code_parm = 0
1775           then do;
1776                call set_value (stv_code_parm);
1777                return;
1778           end;
1779           else if stv_code_parm ^= error_table_$nostars
1780                then return;
1781 %skip(1);
1782           allocate column_map in (names_and_values_area)
1783                set (column_map_ptr);
1784           call match_column_names (stv_option_identifier_parm,
1785                column_map, stv_number_of_matches, stv_code_parm);
1786           if stv_code_parm ^= 0
1787           then return;
1788 %page;
1789           do stv_loop = 1 to number_of_defined_columns;
1790 %skip(1);
1791                if column_map (stv_loop)
1792                then do;
1793                     normalized_option_name = stv_option_name_parm
1794                          || BLANK || table_info.columns.column_name (stv_loop);
1795                     call set_value (stv_code_parm);
1796                     if stv_code_parm ^= 0
1797                     then return;
1798                end;
1799 %skip(1);
1800           end;
1801 %skip(1);
1802           return;
1803 %page;
1804 set_value: proc (
1805 
1806           sv_code_parm                     /* output: success or failure */
1807                        );
1808 %skip(3);
1809 /*
1810 
1811      This proc is called to set the value of a format option.  The variable
1812      stv_system_default_parm is used to determine if the caller wants the
1813      system default value for the named option.  normalized_option_name is
1814      used to determine who's to be set.  stv_option_value_parm is the value
1815      which will be set if stv_system_default_parm is off.  option_type and
1816      option_table_index are used to find the value which will be set when
1817      stv_system_default_parm is on. The bit that indicates whether or not
1818      a value is the same as the system default is set for the general report
1819      and general column options. These bits are used by the get_active entry
1820      to determine which values are considered active. If the caller requested
1821      that it be set to the system default, the value is set from the OPTIONS
1822      table. General column and specific column values from this table
1823      sometimes need the actual value computed based on the current set of
1824      columns. These values are recognizable because they begin with a left
1825      bracket. The procs get_general_column_default_value and
1826      get_specific_column_default_value are called to compute the value. There
1827      is a dependency between the -group option and the two options
1828      -group_footer_trigger and -group_header_trigger. If the -group option
1829      is being set back to the default then the function valid_option_value is
1830      invoked to make sure the other two are set back to their defaults.
1831 
1832 */
1833 %skip(3);
1834 dcl sv_code_parm fixed bin (35) parm;
1835 dcl sv_force_group_triggers_consistency bit (1);
1836 %skip(1);
1837           sv_code_parm = 0;
1838 %skip(1);
1839           if ^stv_system_default_parm
1840           then do;
1841                sv_option_value = stv_option_value_parm;
1842                if ^valid_option_value (stv_option_name_parm, sv_option_value)
1843                then do;
1844                     stv_code_parm = linus_error_$bad_option_value;
1845                     return;
1846                end;
1847                else;
1848           end;
1849           else do;
1850                if option_type = GENERAL_REPORT_OPTION
1851                then do;
1852                     sv_option_value
1853                          = OPTIONS.GENERAL_REPORT.VALUE (option_table_index);
1854                     report_control_info.format_options_flags.
1855                          general_report_default_value (option_table_index) = ON;
1856                end;
1857                else if option_type = GENERAL_COLUMN_OPTION
1858                     then do;
1859                          sv_option_value
1860                               = OPTIONS.GENERAL_COLUMN.VALUE (option_table_index);
1861                          if length (sv_option_value) > 0
1862                          then if substr (sv_option_value, 1, 1) = LEFT_BRACKET
1863                               then call get_general_column_default_value (
1864                                    stv_option_name_parm, sv_option_value);
1865                               else;
1866                          else if stv_option_name_parm = OPTIONS.GENERAL_COLUMN.NAME (INDEX_FOR_GROUP)
1867                               then sv_force_group_triggers_consistency
1868                                    = valid_option_value (stv_option_name_parm, sv_option_value);
1869                               else;
1870                          report_control_info.format_options_flags.
1871                               general_column_default_value (option_table_index) = ON;
1872                     end;
1873                     else do;
1874                          sv_option_value =
1875                               OPTIONS.SPECIFIC_COLUMN.VALUE (option_table_index);
1876                          if length (sv_option_value) > 0
1877                          then if substr (sv_option_value, 1, 1) = LEFT_BRACKET
1878                               then do;
1879                                    sv_spare_option_identifier
1880                                         = after (normalized_option_name, BLANK);
1881                                    call get_specific_column_default_value (
1882                                         stv_option_name_parm,
1883                                         sv_spare_option_identifier,
1884                                         sv_option_value);
1885                               end;
1886                               else;
1887                          else;
1888                     end;
1889                if sv_option_value = "ERROR"
1890                then call ssu_$abort_line (sci_ptr, 0,
1891                     "Unable to set the value of ^a to the system default.",
1892                     normalized_option_name);
1893           end;
1894 %skip(1);
1895           call value_$set (value_seg_ptr, PERMANENT,
1896                normalized_option_name, sv_option_value,
1897                returned_option_value, code);
1898 %skip(1);
1899           if code ^= 0
1900           then call ssu_$abort_line (sci_ptr, code,
1901                "While trying to set the value ^a for ^a.",
1902                sv_option_value, normalized_option_name);
1903 %skip(1);
1904           report_control_info.options_identifier =
1905                report_control_info.options_identifier + 1;
1906 %skip(1);
1907           if stv_system_default_parm
1908           | option_type = SPECIFIC_COLUMN_OPTION
1909           then return;
1910 %page;
1911           if option_type = GENERAL_REPORT_OPTION
1912           then do;
1913                if sv_option_value
1914                = OPTIONS.GENERAL_REPORT.VALUE (option_table_index)
1915                then report_control_info.format_options_flags.
1916                     general_report_default_value (option_table_index) = ON;
1917                else report_control_info.format_options_flags.
1918                     general_report_default_value (option_table_index) = OFF;
1919           end;
1920           else do;
1921                stv_value_has_been_tested = OFF;
1922                if length (sv_option_value) > 0
1923                & length (OPTIONS.GENERAL_COLUMN.VALUE (option_table_index)) > 0
1924                then if substr (OPTIONS.GENERAL_COLUMN.VALUE (
1925                     option_table_index), 1, 1) = LEFT_BRACKET
1926                     then do;
1927                          call get_general_column_default_value (
1928                               stv_option_name_parm, sv_spare_option_value);
1929                          if sv_spare_option_value = "ERROR"
1930                          then call ssu_$abort_line (sci_ptr, 0,
1931                               "Unable to get the default value of ^a.",
1932                               stv_option_name_parm);
1933                          else;
1934                          stv_value_has_been_tested = ON;
1935                          if sv_option_value = sv_spare_option_value
1936                          then report_control_info.format_options_flags.
1937                               general_column_default_value (option_table_index) = ON;
1938                          else report_control_info.format_options_flags.
1939                               general_column_default_value (option_table_index) = OFF;
1940                     end;
1941                     else;
1942                else;
1943                if ^stv_value_has_been_tested
1944                then if sv_option_value
1945                     = OPTIONS.GENERAL_COLUMN.VALUE (option_table_index)
1946                     then report_control_info.format_options_flags.
1947                          general_column_default_value (option_table_index) = ON;
1948                     else report_control_info.format_options_flags.
1949                          general_column_default_value (option_table_index) = OFF;
1950                else;
1951           end;
1952 %skip(1);
1953           return;
1954 %skip(1);
1955      end set_value;
1956 %skip(1);
1957      end set_the_values;
1958 %page;
1959 setup_to_do_reporting: proc;
1960 %skip(3);
1961 /*
1962 
1963      This proc is called to setup all the areas, temp segs, etc.  that are
1964      needed to produce linus reports through the display request.  Each
1965      "thing" it needs is described below before it is created.
1966 
1967 */
1968 %skip(1);
1969           sci_ptr = lcb.subsystem_control_info_ptr;
1970 %skip(1);
1971           /* Create the info structure. */
1972 %skip(1);
1973           allocate report_control_info in (lcb.static_area)
1974                set (report_cip);
1975           unspec (report_control_info) = OFF;
1976 %skip(1);
1977           /* Create the value segment. */
1978 %skip(1);
1979           call hcs_$make_seg (get_pdir_(), "linus_format_options.value", "",
1980                REW_ACCESS_BIN, value_seg_ptr, code);
1981           if code ^= 0
1982           then call ssu_$abort_line (sci_ptr, code,
1983                "^a", "While trying to create the options' value segment.");
1984 %skip(1);
1985           /* Initialize its contents. */
1986 %skip(1);
1987           call value_$init_seg (value_seg_ptr, 0, null(), 0, code);
1988           if code ^= 0
1989           then call ssu_$abort_line (sci_ptr, code,
1990                "^a", "While trying to initialize the options' value segment.");
1991           report_control_info.value_seg_ptr = value_seg_ptr;
1992 %skip(1);
1993           /* Create a temp seg for name-value allocations. Define an area
1994              over it. This area will be emptied from now on every time
1995              the initialize entrypoint is called, via a call to
1996              release_area_. */
1997 %skip(1);
1998           call get_temp_segment_ (me, temp_seg_ptr, code);
1999           if code ^= 0
2000           then call ssu_$abort_line (sci_ptr, code,
2001                "While trying to create a temporary segment for the options.");
2002           names_and_values_area_ptr = temp_seg_ptr;
2003           call mdbm_util_$mu_define_area (names_and_values_area_ptr,
2004                (sys_info$max_seg_size), "options.LIN", EXTENSIBLE,
2005                NON_FREEING, NO_ZERO_ON_ALLOC, NO_ZERO_ON_FREE, code);
2006           if code ^= 0
2007           then call ssu_$abort_line (sci_ptr, code,
2008                "While trying to define an area for allocations of options.");
2009           report_control_info.name_value_area_ptr = names_and_values_area_ptr;
2010 %skip(1);
2011           /* Create a temp seg for star name processing and other temp operations. */
2012 %skip(1);
2013           call get_temp_segment_ (me, temp_seg_ptr, code);
2014           if code ^= 0
2015           then call ssu_$abort_line (sci_ptr, code,
2016                "While trying to create a temporary segment for the options.");
2017           report_control_info.name_value_temp_seg_ptr = temp_seg_ptr;
2018 %skip(1);
2019           /* Create a temp seg/area for display work space. */
2020 %skip(1);
2021           call get_temp_segment_ (me, temp_seg_ptr, code);
2022           if code ^= 0
2023           then call ssu_$abort_line (sci_ptr, code,
2024                "While trying to create a temporary segment for the options.");
2025           call mdbm_util_$mu_define_area (temp_seg_ptr,
2026                (sys_info$max_seg_size), "display.LIN", EXTENSIBLE,
2027                NON_FREEING, NO_ZERO_ON_ALLOC, NO_ZERO_ON_FREE, code);
2028           if code ^= 0
2029           then call ssu_$abort_line (sci_ptr, code,
2030                "While trying to define an area for allocations for display.");
2031           report_control_info.display_work_area_ptr = temp_seg_ptr;
2032 %skip(1);
2033           /* Create a temp seg for holding the formatted page. */
2034 %skip(1);
2035           call get_temp_segment_ (me, temp_seg_ptr, code);
2036           if code ^= 0
2037           then call ssu_$abort_line (sci_ptr, code,
2038                "While trying to create a temporary segment for the report.");
2039           report_control_info.report_temp_seg_ptr = temp_seg_ptr;
2040 %skip(1);
2041           /* Create a temp seg for report allocations. Define an
2042              area over it. */
2043 %skip(1);
2044           call get_temp_segment_ (me, temp_seg_ptr, code);
2045           if code ^= 0
2046           then call ssu_$abort_line (sci_ptr, code,
2047                "While trying to create a temporary segment for the report.");
2048           call mdbm_util_$mu_define_area (temp_seg_ptr,
2049                (sys_info$max_seg_size), "options.LIN", EXTENSIBLE,
2050                NON_FREEING, NO_ZERO_ON_ALLOC, NO_ZERO_ON_FREE, code);
2051           if code ^= 0
2052           then call ssu_$abort_line (sci_ptr, code,
2053                "While trying to define an area for allocations of report information.");
2054           report_control_info.report_work_area_ptr = temp_seg_ptr;
2055 %skip(1);
2056           /* Create 4 temp segs for report building workspace. */
2057 %skip(1);
2058           call get_temp_segment_ (me, temp_seg_ptr, code);
2059           if code ^= 0
2060           then call ssu_$abort_line (sci_ptr, code,
2061                "While trying to create a temporary segment for the report.");
2062           report_control_info.input_string_temp_seg_ptr = temp_seg_ptr;
2063 %skip(1);
2064           call get_temp_segment_ (me, temp_seg_ptr, code);
2065           if code ^= 0
2066           then call ssu_$abort_line (sci_ptr, code,
2067                "While trying to create a temporary segment for the report.");
2068           report_control_info.output_string_temp_seg_ptr = temp_seg_ptr;
2069 %skip(1);
2070           call get_temp_segment_ (me, temp_seg_ptr, code);
2071           if code ^= 0
2072           then call ssu_$abort_line (sci_ptr, code,
2073                "While trying to create a temporary segment for the report.");
2074           report_control_info.editing_strings_temp_seg_ptr = temp_seg_ptr;
2075 %skip(1);
2076           call get_temp_segment_ (me, temp_seg_ptr, code);
2077           if code ^= 0
2078           then call ssu_$abort_line (sci_ptr, code,
2079                "While trying to create a temporary segment for the report.");
2080           report_control_info.headers_temp_seg_ptr = temp_seg_ptr;
2081 %skip(1);
2082           /* Set a few values so we start cleanly */
2083 %skip(1);
2084           report_control_info.format_report_info_ptr = null ();
2085           report_control_info.display_iocb_ptr = null ();
2086           report_control_info.temp_dir_name = get_pdir_ ();
2087           allocate status_branch in (names_and_values_area) set (status_ptr);
2088           call expand_pathname_ (report_control_info.temp_dir_name,
2089                directory_name, entry_name, code);
2090           if code ^= 0
2091           then call ssu_$abort_line (sci_ptr, code,
2092                "While trying to expand ^a.", report_control_info.temp_dir_name);
2093           call hcs_$status_long (directory_name, entry_name, 1,
2094                status_ptr, null (), code);
2095           if code ^= 0 & code ^= error_table_$no_s_permission
2096           then call ssu_$abort_line (sci_ptr, code,
2097                "While trying to determine the unique id of ^a.",
2098                report_control_info.temp_dir_name);
2099           report_control_info.temp_dir_unique_id = status_branch.long.uid;
2100 %skip(1);
2101           return;
2102 %skip(1);
2103      end setup_to_do_reporting;
2104 %page;
2105 valid_option_value: proc (
2106 
2107           vov_option_name_parm,         /* input: option name */
2108           vov_option_value_parm         /* input: option value */
2109                          ) returns (bit (1));
2110 %skip(3);
2111 /*
2112 
2113      This function is invoked to check the value for an option.  It expects
2114      that vov_option_name_parm contains a valid option name which has been
2115      expanded, and that vov_option_value_parm contains the value to check for
2116      validity.  This function calls an internal procedure to do the checking.
2117      These internal procedures are declared in the three tables immediately
2118      following this description.  If it is a valid value, "1"b is returned.
2119      "0"b indicates an invalid value.
2120 
2121 */
2122 %skip(1);
2123 dcl vov_any_or_all bit (1) aligned;
2124 dcl vov_check_result_bit bit (1) aligned;
2125 %skip(1);
2126 dcl vov_check_procs_for_general_report_options (NUMBER_OF_GENERAL_REPORT_OPTIONS_IN_TABLE) entry init (
2127 
2128 check_any_single_printable_character,   /* "-delimiter" */
2129 check_on_or_off,                        /* "-format_document_controls" */
2130 check_on_or_off,                        /* "-hyphenation" */
2131 check_any_character_string,             /* "-page_footer_value" */
2132 check_any_character_string,             /* "-page_header_value" */
2133 check_zero_or_greater_than_six,         /* "-page_length" */
2134 check_zero_or_any_positive_integer,     /* "-page_width" */
2135 check_on_or_off,                        /* "-title_line" */
2136 check_any_printable_string_no_NL        /* "-truncation" */
2137 );
2138 %skip(1);
2139 dcl vov_check_procs_for_general_column_options (NUMBER_OF_GENERAL_COLUMN_OPTIONS_IN_TABLE) entry init (
2140 
2141 check_all_column_names_eventually,      /* "-column_order" */
2142 check_any_column_names_or_none,         /* "-count" */
2143 check_any_column_names_or_none,         /* "-exclude" */
2144 check_and_keep_triggers_consistent,     /* "-group" */
2145 check_any_valid_group_list,             /* "-group_footer_trigger" */
2146 check_any_character_string,             /* "-group_footer_value" */
2147 check_any_valid_group_list,             /* "-group_header_trigger" */
2148 check_any_character_string,             /* "-group_header_value" */
2149 check_any_column_names_or_none,         /* "-outline" */
2150 check_any_column_names_or_none,         /* "-page_break" */
2151 check_any_character_string,             /* "-row_footer_value" */
2152 check_any_character_string,             /* "-row_header_value" */
2153 check_subcount_list_or_none,            /* "-subcount" */
2154 check_subtotal_list_or_none,            /* "-subtotal" */
2155 check_any_column_names_or_none          /* "-total" */
2156 );
2157 %skip(1);
2158 dcl vov_check_procs_for_specific_column_options (NUMBER_OF_SPECIFIC_COLUMN_OPTIONS_IN_TABLE) entry init (
2159 
2160 check_any_alignment_mode,               /* "-alignment" */
2161 check_any_character_string,             /* "-editing" */
2162 check_any_folding_action,               /* "-folding" */
2163 check_any_printable_string_no_NL,       /* "-separator" */
2164 check_any_character_string,             /* "-title" */
2165 check_any_positive_integer              /* "-width" */
2166 );
2167 %skip(1);
2168 dcl vov_character_string char (80) varying;
2169 dcl vov_complete_the_list bit (1) aligned;
2170 dcl vov_loop fixed bin;
2171 dcl vov_loop_limit fixed bin;
2172 dcl vov_number_tester fixed bin;
2173 dcl vov_one_to_nine_found bit (1) aligned;
2174 dcl vov_option_name_parm char (*) varying parm;
2175 dcl vov_option_value_parm char (*) varying parm;
2176 dcl vov_target_character char (1);
2177 %skip(3);
2178           vov_check_result_bit = OFF;
2179 %skip(1);
2180           call lookup_option_number (vov_option_name_parm,
2181                option_type, option_table_index);
2182           if option_table_index = 0
2183           then return (OFF);
2184 %skip(1);
2185           if option_type = GENERAL_REPORT_OPTION
2186           then call vov_check_procs_for_general_report_options (option_table_index);
2187           else if option_type = GENERAL_COLUMN_OPTION
2188                then call vov_check_procs_for_general_column_options (option_table_index);
2189                else call vov_check_procs_for_specific_column_options (option_table_index);
2190 %skip(1);
2191           return (vov_check_result_bit);
2192 %page;
2193 check_all_column_names_eventually: proc;
2194 %skip(3);
2195           vov_any_or_all = ANY;
2196           vov_complete_the_list = ON;
2197           vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2198 %skip(1);
2199           return;
2200 %skip(1);
2201      end check_all_column_names_eventually;
2202 %page;
2203 check_and_keep_triggers_consistent: proc;
2204 %skip(1);
2205 dcl caktc_group_list_ptr ptr;
2206 dcl caktc_inner_loop fixed bin;
2207 dcl caktc_loop fixed bin;
2208 %skip(3);
2209           if vov_option_value_parm = ""
2210           then do;
2211                do caktc_loop = INDEX_FOR_GROUP_HEADER_TRIGGER, INDEX_FOR_GROUP_FOOTER_TRIGGER;
2212                     call value_$set (value_seg_ptr, PERMANENT,
2213                          OPTIONS.GENERAL_COLUMN.NAME (caktc_loop),
2214                          OPTIONS.GENERAL_COLUMN.VALUE (caktc_loop),
2215                          returned_option_value, code);
2216                     if code ^= 0
2217                     then call ssu_$abort_line (sci_ptr, code,
2218                          "While trying to set the value ^a for ^a.",
2219                          OPTIONS.GENERAL_COLUMN.NAME (caktc_loop),
2220                          OPTIONS.GENERAL_COLUMN.VALUE (caktc_loop));
2221                     report_control_info.format_options_flags.
2222                          general_column_default_value (caktc_loop) = ON;
2223                end;
2224                vov_check_result_bit = ON;
2225                return;
2226           end;
2227 %skip(1);
2228           vov_any_or_all = ANY;
2229           vov_complete_the_list = OFF;
2230           vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2231           if ^vov_check_result_bit
2232           then return;
2233 %skip(1);
2234           caktc_group_list_ptr = judgement_table_ptr;
2235           caktc_option_value = vov_option_value_parm;
2236           do caktc_loop = INDEX_FOR_GROUP_HEADER_TRIGGER, INDEX_FOR_GROUP_FOOTER_TRIGGER;
2237                call value_$get (value_seg_ptr, PERMANENT, OPTIONS.GENERAL_COLUMN.NAME (caktc_loop),
2238                     vov_option_value_parm, code);
2239                if code ^= 0
2240                then call ssu_$abort_line (sci_ptr, code,
2241                     "While trying to get the value of ^a.",
2242                     OPTIONS.GENERAL_COLUMN.NAME (caktc_loop));
2243                if vov_option_value_parm ^= ""
2244                then do;
2245                     vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2246                     do caktc_inner_loop = 1 to number_of_defined_columns;
2247                          if judgement_table.present (caktc_inner_loop)
2248                          then if ^(caktc_group_list_ptr -> judgement_table.present (caktc_inner_loop))
2249                               then judgement_table.present (caktc_inner_loop) = OFF;
2250                               else;
2251                          else;
2252                     end;
2253                     vov_option_value_parm = "";
2254                     do caktc_inner_loop = 1 to number_of_defined_columns;
2255                          if judgement_table.present (caktc_inner_loop)
2256                          then vov_option_value_parm = vov_option_value_parm
2257                               || table_info.columns (caktc_inner_loop).column_name || BLANK;
2258                          else;
2259                     end;
2260                     vov_option_value_parm = rtrim (vov_option_value_parm);
2261                     call value_$set (value_seg_ptr, PERMANENT,
2262                          OPTIONS.GENERAL_COLUMN.NAME (caktc_loop), vov_option_value_parm,
2263                          returned_option_value, code);
2264                     if code ^= 0
2265                     then call ssu_$abort_line (sci_ptr, code,
2266                          "While trying to set the value ^a for ^a.",
2267                          vov_option_value_parm, OPTIONS.GENERAL_COLUMN.NAME (caktc_loop));
2268                     if vov_option_value_parm = ""
2269                     then report_control_info.format_options_flags.
2270                          general_column_default_value (caktc_loop) = ON;
2271                end;
2272           end;
2273 %skip(1);
2274           vov_check_result_bit = ON;
2275           vov_option_value_parm = caktc_option_value;
2276 %skip(1);
2277           return;
2278 %skip(1);
2279      end check_and_keep_triggers_consistent;
2280 %page;
2281 check_any_alignment_mode: proc;
2282 %skip(3);
2283           if vov_option_value_parm = RIGHT
2284           | vov_option_value_parm = LEFT
2285           | vov_option_value_parm = CENTER
2286           | vov_option_value_parm = BOTH
2287           then vov_check_result_bit = ON;
2288           else do;
2289                vov_character_string = before (vov_option_value_parm, BLANK);
2290                if vov_character_string ^= DECIMAL
2291                then return;
2292                vov_character_string
2293                     = ltrim (rtrim (after (vov_option_value_parm, DECIMAL)));
2294                if verify (vov_character_string, DIGITS) = 0
2295                then if convert (vov_loop, vov_character_string) ^= 0
2296                     then vov_check_result_bit = ON;
2297                     else;
2298                else;
2299           end;
2300 %skip(1);
2301           return;
2302 %skip(1);
2303      end check_any_alignment_mode;
2304 %page;
2305 check_any_character_string: proc;
2306 %skip(3);
2307           vov_check_result_bit = ON;
2308 %skip(1);
2309           return;
2310 %skip(1);
2311      end check_any_character_string;
2312 %skip(1);
2313 check_any_column_names_or_none: proc;
2314 %skip(3);
2315           if vov_option_value_parm = ""
2316           then do;
2317                vov_check_result_bit = ON;
2318                return;
2319           end;
2320           vov_any_or_all = ANY;
2321           vov_complete_the_list = OFF;
2322           vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2323 %skip(1);
2324           return;
2325 %skip(1);
2326      end check_any_column_names_or_none;
2327 %skip(3);
2328 check_any_folding_action: proc;
2329 %skip(3);
2330           if vov_option_value_parm = FILL
2331           | vov_option_value_parm = TRUNCATE
2332           then vov_check_result_bit = ON;
2333 %skip(1);
2334           return;
2335 %skip(1);
2336      end check_any_folding_action;
2337 %page;
2338 check_any_printable_string_no_NL: proc;
2339 %skip(3);
2340           vov_loop_limit = length (vov_option_value_parm);
2341           if vov_loop_limit = 0
2342           then  do;
2343                vov_check_result_bit = ON;
2344                return;
2345           end;
2346           do vov_loop = 1 to vov_loop_limit;
2347                vov_target_character = substr (vov_option_value_parm, vov_loop, 1);
2348                if vov_target_character < BLANK
2349                | vov_target_character > TILDE
2350                then return;
2351           end;
2352           vov_check_result_bit = ON;
2353 %skip(1);
2354           return;
2355 %skip(1);
2356      end check_any_printable_string_no_NL;
2357 %skip(3);
2358 check_any_single_printable_character: proc;
2359 %skip(3);
2360           if length (vov_option_value_parm) = 1
2361           then if vov_option_value_parm >= BLANK
2362                & vov_option_value_parm <= TILDE
2363                then vov_check_result_bit = ON;
2364                else;
2365           else;
2366 %skip(1);
2367           return;
2368 %skip(1);
2369      end check_any_single_printable_character;
2370 %page;
2371 check_any_positive_integer: proc;
2372 %skip(3);
2373           vov_loop_limit = length (vov_option_value_parm);
2374           if vov_loop_limit = 0
2375           then return;
2376           vov_one_to_nine_found = OFF;
2377           do vov_loop = 1 to vov_loop_limit;
2378                vov_target_character = substr (vov_option_value_parm, vov_loop, 1);
2379                if vov_target_character < ZERO
2380                | vov_target_character > NINE
2381                then return;
2382                if vov_target_character ^= ZERO
2383                then vov_one_to_nine_found = ON;
2384           end;
2385           if vov_one_to_nine_found
2386           then vov_check_result_bit = ON;
2387 %skip(1);
2388           return;
2389 %skip(1);
2390      end check_any_positive_integer;
2391 %page;
2392 check_any_valid_group_list: proc;
2393 %skip(1);
2394 dcl cavgl_group_list_judgement_table_ptr ptr;
2395 dcl cavgl_loop fixed bin;
2396 %skip(3);
2397           if vov_option_value_parm = ""
2398           then do;
2399                vov_check_result_bit = ON;
2400                return;
2401           end;
2402           vov_any_or_all = ANY;
2403           vov_complete_the_list = OFF;
2404           vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2405           if ^vov_check_result_bit
2406           then return;
2407           cavgl_group_list_judgement_table_ptr = judgement_table_ptr;
2408           cavgl_save_option_value = vov_option_value_parm;
2409           call value_$get (value_seg_ptr, PERMANENT, OPTIONS.GENERAL_COLUMN.NAME
2410                (INDEX_FOR_GROUP), vov_option_value_parm, code);
2411           if code ^= 0
2412           then call ssu_$abort_line (sci_ptr, code,
2413                "While trying to get the value of ^a.",
2414                OPTIONS.GENERAL_COLUMN.NAME (INDEX_FOR_GROUP));
2415           vov_check_result_bit = replace_column_list_after_checking (judgement_table_ptr);
2416           if ^vov_check_result_bit
2417           then return;
2418           vov_option_value_parm = cavgl_save_option_value;
2419           vov_check_result_bit = OFF;
2420 %skip(1);
2421           do cavgl_loop = 1 to number_of_defined_columns;
2422                if cavgl_group_list_judgement_table_ptr -> judgement_table.present (cavgl_loop)
2423                then if ^judgement_table.present (cavgl_loop)
2424                     then return;
2425                     else;
2426                else;
2427           end;
2428           vov_check_result_bit = ON;
2429 %skip(1);
2430           return;
2431 %skip(1);
2432      end check_any_valid_group_list;
2433 %page;
2434 check_on_or_off: proc;
2435 %skip(3);
2436           if vov_option_value_parm = "on"
2437           | vov_option_value_parm = "off"
2438           then vov_check_result_bit = ON;
2439 %skip(1);
2440           return;
2441 %skip(1);
2442      end check_on_or_off;
2443 %page;
2444 check_subcount_list_or_none: proc;
2445 %skip(3);
2446           if vov_option_value_parm = ""
2447           then do;
2448                vov_check_result_bit = ON;
2449                return;
2450           end;
2451 %skip(1);
2452           vov_check_result_bit = replace_subtotal_list_after_checking (ALLOW_DUPLICATES);
2453 %skip(1);
2454           return;
2455 %skip(1);
2456      end check_subcount_list_or_none;
2457 %skip(3);
2458 check_subtotal_list_or_none: proc;
2459 %skip(3);
2460           if vov_option_value_parm = ""
2461           then do;
2462                vov_check_result_bit = ON;
2463                return;
2464           end;
2465 %skip(1);
2466           vov_check_result_bit = replace_subtotal_list_after_checking (DONT_ALLOW_DUPLICATES);
2467 %skip(1);
2468           return;
2469 %skip(1);
2470      end check_subtotal_list_or_none;
2471 %skip(3);
2472 check_zero_or_any_positive_integer: proc;
2473 %skip(3);
2474           if verify (vov_option_value_parm, DIGITS) = 0
2475           then vov_check_result_bit = ON;
2476 %skip(1);
2477           return;
2478 %skip(1);
2479      end check_zero_or_any_positive_integer;
2480 %page;
2481 check_zero_or_greater_than_six: proc;
2482 %skip(3);
2483           if verify (vov_option_value_parm, DIGITS) = 0
2484           then do;
2485                vov_number_tester = convert (vov_number_tester,
2486                     vov_option_value_parm);
2487                if vov_number_tester = 0
2488                |  vov_number_tester > 6
2489                then vov_check_result_bit = ON;
2490           end;
2491 %skip(1);
2492           return;
2493 %skip(1);
2494      end check_zero_or_greater_than_six;
2495 %page;
2496 replace_column_list_after_checking: proc (
2497           rclac_judgement_table_ptr_parm          /* output: points to the judgement table */
2498                                          ) returns (bit(1));
2499 %skip(3);
2500 /*
2501 
2502      This proc is called to check a list of columns, which may be given as
2503      column names or numbers, and then create a new list containing only column
2504      names if the check proved sucessful.  It expects that
2505      vov_option_value_parm contains the list of columns.  The variable
2506      vov_any_or_all_parm dictates what type of checking is done.  Since the
2507      time when this code was written the restriction of having all columns
2508      named in a "-column_order" option was removed, but this subroutine still
2509      provides the service of validating that all columns are present in a list
2510      because it is felt an additional option which has this requirement may
2511      be added sometime in the future.  If the check proves sucessfull,
2512      vov_option_value_parm is replaced with a list of column names, and "1"b is
2513      returned.  An unsucessful check returns "0"b and the value of
2514      vov_option_value_parm isn't set. If the variable vov_complete_the_list
2515      is on the list is filled in with any missing columns; if it is off the
2516      list will only contain the names of the columns found. The judgment_table
2517      structure if filled in to describe the original list found. Each bit
2518      turned on indicates that particular column was found in the list and the
2519      number field of the structure indicates where in the list it was found.
2520 
2521 */
2522 %skip(1);
2523 dcl rclac_code fixed bin (35);
2524 dcl rclac_column_name_length fixed bin;
2525 dcl rclac_current_position fixed bin;
2526 dcl rclac_finished bit (1) aligned;
2527 dcl rclac_first_blank fixed bin;
2528 dcl rclac_hit bit (1) aligned;
2529 dcl rclac_inner_loop fixed bin;
2530 dcl 1 rclac_judgement_table (number_of_defined_columns) like judgement_table based (rclac_judgement_table_ptr);
2531 dcl rclac_judgement_table_ptr ptr;
2532 dcl rclac_judgement_table_ptr_parm ptr parm;
2533 dcl rclac_loop fixed bin;
2534 dcl rclac_no_of_claimed_digits fixed bin;
2535 dcl rclac_spare_option_value_length fixed bin;
2536 dcl rclac_still_skipping_blanks bit (1) aligned;
2537 dcl rclac_target_character char (1);
2538 %skip(1);
2539           rclac_judgement_table_ptr_parm = null ();
2540           if vov_option_value_parm = ""
2541           then return (OFF);
2542 %skip(1);
2543           rclac_spare_option_value =  ltrim (rtrim (translate
2544                (vov_option_value_parm, BLANK, TAB))) || BLANK;
2545           rclac_spare_option_value_length = length (rclac_spare_option_value);
2546           rclac_current_position = 1;
2547 %skip(1);
2548           allocate rclac_judgement_table in (names_and_values_area)
2549                set (rclac_judgement_table_ptr);
2550           unspec (rclac_judgement_table) = OFF;
2551 %skip(1);
2552           rclac_finished = OFF;
2553 %skip(1);
2554           do rclac_loop = 1 to number_of_defined_columns while (^rclac_finished);
2555 %skip(1);
2556                rclac_first_blank = index (substr (rclac_spare_option_value,
2557                     rclac_current_position), BLANK)
2558                     + rclac_current_position - 1;
2559                if rclac_first_blank >= rclac_spare_option_value_length
2560                then if rclac_loop ^= number_of_defined_columns
2561                     & vov_any_or_all = ALL
2562                     then return (OFF);
2563                     else rclac_finished = ON;
2564                else;
2565 %skip(1);
2566                rclac_target_character = substr (rclac_spare_option_value,
2567                     rclac_current_position, 1);
2568                if rclac_target_character >= ZERO
2569                & rclac_target_character <= NINE
2570                then do;
2571                     rclac_no_of_claimed_digits
2572                          = rclac_first_blank - rclac_current_position;
2573                     if rclac_no_of_claimed_digits < 1
2574                     then return (OFF);
2575 %skip(1);
2576                     rclac_judgement_table.number (rclac_loop) = cv_dec_check_
2577                          (substr (rclac_spare_option_value, rclac_current_position,
2578                          rclac_no_of_claimed_digits), rclac_code);
2579                     if rclac_code ^= 0
2580                     then return (OFF);
2581 %skip(1);
2582                     if rclac_judgement_table.number (rclac_loop) < 1
2583                     | rclac_judgement_table.number (rclac_loop) > number_of_defined_columns
2584                     then return (OFF);
2585                end;
2586                else do;
2587                     rclac_hit = OFF;
2588                     rclac_column_name_length
2589                          = rclac_first_blank - rclac_current_position;
2590 %skip(1);
2591                     do rclac_inner_loop = 1 to number_of_defined_columns while (^rclac_hit);
2592                          if substr (rclac_spare_option_value,
2593                          rclac_current_position, rclac_column_name_length)
2594                          = table_info.columns.column_name (rclac_inner_loop)
2595                          then rclac_hit = ON;
2596                     end;
2597 %skip(1);
2598                     if ^rclac_hit
2599                     then return (OFF);
2600                     else rclac_judgement_table.number (rclac_loop)
2601                          = rclac_inner_loop - 1;
2602                end;
2603 %skip(1);
2604                if rclac_judgement_table.present (rclac_judgement_table.number (rclac_loop))
2605                then return (OFF);
2606 %skip(1);
2607                rclac_judgement_table.present (
2608                     rclac_judgement_table.number (rclac_loop)) = ON;
2609 %skip(1);
2610                if ^rclac_finished
2611                then do;
2612                     rclac_still_skipping_blanks = ON;
2613                     rclac_current_position = rclac_first_blank + 1;
2614                     do while (rclac_still_skipping_blanks);
2615                          if substr (rclac_spare_option_value,
2616                          rclac_current_position, 1) ^= BLANK
2617                          then rclac_still_skipping_blanks = OFF;
2618                          else rclac_current_position
2619                               = rclac_current_position + 1;
2620                     end;
2621                     if rclac_current_position < rclac_spare_option_value_length
2622                     & rclac_loop >= number_of_defined_columns
2623                     then return (OFF);
2624                end;
2625           end;
2626 %skip(1);
2627           if vov_any_or_all = ALL
2628           then do rclac_loop = 1 to number_of_defined_columns;
2629                if ^rclac_judgement_table.present (rclac_loop)
2630                then return (OFF);
2631           end;
2632 %skip(1);
2633           rclac_spare_option_value = "";
2634 %skip(1);
2635           do rclac_loop = 1 to number_of_defined_columns;
2636                if rclac_judgement_table.number (rclac_loop) ^= 0
2637                then rclac_spare_option_value = rclac_spare_option_value
2638                     || table_info.columns.column_name (
2639                     rclac_judgement_table.number (rclac_loop)) || BLANK;
2640           end;
2641 %skip(1);
2642           if vov_complete_the_list
2643           then do rclac_loop = 1 to number_of_defined_columns;
2644                if ^rclac_judgement_table.present (rclac_loop)
2645                then rclac_spare_option_value = rclac_spare_option_value
2646                     || table_info.columns.column_name (rclac_loop) || BLANK;
2647           end;
2648 %skip(1);
2649           vov_option_value_parm = rtrim (rclac_spare_option_value);
2650           rclac_judgement_table_ptr_parm = rclac_judgement_table_ptr;
2651 %skip(1);
2652           return (ON);
2653 %skip(1);
2654      end replace_column_list_after_checking;
2655 %page;
2656 replace_subtotal_list_after_checking: proc (rslac_allow_duplicates_parm) returns (bit(1));
2657 %skip(3);
2658 /*
2659 
2660      This proc is called to check a list of subtotal triplets, and then
2661      create a new list if the check proved successful.  The syntax of a
2662      triplet is "column_1,column_2{,reset|running}".  Each triplet is
2663      separated by whitespace. column_N can be given as a column name or
2664      column number. It expects that vov_option_value_parm contains the
2665      list of subtotal triplets. If the check proves successful,
2666      vov_option_value_parm is replaced with a list of triplets which has
2667      each column number replaced by the column name, and the optional
2668      third portion of a triplet filled in. A single blank separates each
2669      triplet in the new list.
2670 
2671 */
2672 %skip(1);
2673 dcl rslac_allow_duplicates_parm bit (1) aligned parm;
2674 dcl rslac_blank_position fixed bin;
2675 dcl rslac_code fixed bin (35);
2676 dcl rslac_current_position fixed bin;
2677 dcl rslac_original_option_value_length fixed bin;
2678 dcl rslac_still_parsing bit (1) aligned;
2679 %skip(1);
2680           if vov_option_value_parm = ""
2681           then return (OFF);
2682 %skip(1);
2683           rslac_original_option_value =  ltrim (rtrim (translate
2684                (vov_option_value_parm, BLANK, TAB))) || BLANK;
2685           rslac_original_option_value_length
2686                = length (rslac_original_option_value);
2687           rslac_result_option_value = "";
2688           rslac_current_position = 1;
2689           rslac_still_parsing = ON;
2690 %skip(1);
2691           do while (rslac_still_parsing);
2692                call get_triplet (rslac_code);
2693                if rslac_code = 0
2694                then call parse_triplet (rslac_allow_duplicates_parm, rslac_code);
2695           end;
2696 %skip(1);
2697           if rslac_code ^= 0
2698           then return (OFF);
2699 %skip(1);
2700           vov_option_value_parm = rtrim (rslac_result_option_value);
2701 %skip(1);
2702           return (ON);
2703 %page;
2704 get_triplet: proc (gt_code_parm);
2705 %skip(3);
2706 dcl gt_code_parm fixed bin (35) parm;
2707 dcl gt_still_skipping_blanks bit (1) aligned;
2708 %skip(1);
2709           gt_code_parm = 0;
2710           rslac_blank_position
2711                = index (substr (rslac_original_option_value,
2712                rslac_current_position), BLANK);
2713           rslac_triplet = substr (rslac_original_option_value,
2714                rslac_current_position, rslac_blank_position - 1);
2715           rslac_current_position
2716                = rslac_current_position + rslac_blank_position;
2717 %skip(1);
2718           if rslac_current_position >= rslac_original_option_value_length
2719           then rslac_still_parsing = OFF;
2720           else do;
2721                gt_still_skipping_blanks = ON;
2722                do while (gt_still_skipping_blanks);
2723                     if substr (rslac_original_option_value,
2724                     rslac_current_position, 1) = BLANK
2725                     then rslac_current_position = rslac_current_position + 1;
2726                     else gt_still_skipping_blanks = OFF;
2727                end;
2728           end;
2729 %skip(1);
2730           return;
2731 %skip(1);
2732      end get_triplet;
2733 %page;
2734 parse_triplet: proc (
2735           pt_allow_duplicates_parm,     /* input: on means allow duplicate definitions,
2736                                            a subtotal can also "watch" itself */
2737            pt_code_parm                 /* output: success or failure */
2738                     );
2739 %skip(3);
2740 dcl pt_allow_duplicates_parm bit (1) aligned parm;
2741 dcl pt_character_string char (80) varying;
2742 dcl pt_code_parm fixed bin (35) parm;
2743 dcl pt_column_number fixed bin;
2744 dcl pt_comma_position fixed bin;
2745 dcl pt_current_position fixed bin;
2746 dcl pt_first_column_found fixed bin;
2747 dcl pt_hit bit (1) aligned;
2748 dcl pt_inner_loop fixed bin;
2749 dcl pt_loop fixed bin;
2750 dcl pt_second_column_found fixed bin;
2751 dcl pt_triplet_length fixed bin;
2752 %skip(1);
2753           pt_code_parm = 1;
2754           pt_triplet_length = length (rslac_triplet);
2755           pt_current_position = 1;
2756 %skip(1);
2757           do pt_loop = 1 to 2;
2758                pt_comma_position = index (substr (rslac_triplet,
2759                     pt_current_position), COMMA);
2760                if pt_comma_position = 0
2761                then if pt_loop = 1
2762                     then return;
2763                     else pt_comma_position
2764                          = pt_triplet_length + 2 - pt_current_position;
2765                else;
2766                pt_character_string = substr (rslac_triplet,
2767                     pt_current_position, pt_comma_position - 1);
2768                pt_current_position = pt_current_position + pt_comma_position;
2769                if pt_current_position > pt_triplet_length
2770                & pt_loop = 1
2771                then return;
2772                if verify (pt_character_string, DIGITS) = 0
2773                then do;
2774                     pt_column_number = convert (pt_column_number,
2775                          pt_character_string);
2776                     if pt_column_number < 1
2777                     | pt_column_number > number_of_defined_columns
2778                     then return;
2779                     else;
2780                     rslac_result_option_value
2781                          = rslac_result_option_value
2782                          || table_info.columns.column_name (pt_column_number) || COMMA;
2783                     if pt_loop = 1
2784                     then pt_first_column_found = pt_column_number;
2785                     else pt_second_column_found = pt_column_number;
2786                end;
2787                else do;
2788                     pt_hit = OFF;
2789                     do pt_inner_loop = 1 to number_of_defined_columns while (^pt_hit);
2790                          if pt_character_string
2791                          = table_info.columns.column_name (pt_inner_loop)
2792                          then do;
2793                               pt_hit = ON;
2794                               pt_column_number = pt_inner_loop;
2795                          end;
2796                     end;
2797                     if ^pt_hit
2798                     then return;
2799                     else;
2800                     if pt_loop = 1
2801                     then pt_first_column_found = pt_column_number;
2802                     else pt_second_column_found = pt_column_number;
2803                     rslac_result_option_value
2804                          = rslac_result_option_value
2805                          || pt_character_string || COMMA;
2806                end;
2807           end;
2808 %skip(1);
2809           if ^pt_allow_duplicates_parm
2810           then if pt_first_column_found = pt_second_column_found
2811                then return;
2812                else;
2813           else;
2814 %skip(1);
2815           if pt_current_position >= pt_triplet_length
2816           then rslac_result_option_value
2817                = rslac_result_option_value || RESET || BLANK;
2818           else do;
2819                pt_character_string = substr (rslac_triplet,
2820                     pt_current_position);
2821                if pt_character_string = RESET
2822                then rslac_result_option_value
2823                     = rslac_result_option_value || RESET || BLANK;
2824                else if pt_character_string = RUNNING
2825                     then rslac_result_option_value
2826                          = rslac_result_option_value || RUNNING || BLANK;
2827                     else return;
2828           end;
2829 %skip(1);
2830           pt_code_parm = 0;
2831 %skip(1);
2832           return;
2833 %skip(1);
2834      end parse_triplet;
2835 %skip(1);
2836      end replace_subtotal_list_after_checking;
2837 %skip(1);
2838      end valid_option_value;
2839 %page;
2840 %skip(1);
2841 dcl ALL bit (1) aligned static int options (constant) init ("1"b);
2842 dcl ALLOW_DUPLICATES bit (1) aligned static int options (constant) init ("1"b);
2843 dcl ANY bit (1) aligned static int options (constant) init ("0"b);
2844 %skip(1);
2845 dcl BLANK char (1) static int options (constant) init (" ");
2846 dcl BOTH char (4) static int options (constant) init ("both");
2847 %skip(1);
2848 dcl CENTER char (6) static int options (constant) init ("center");
2849 dcl COMMA char (1) static int options (constant) init (",");
2850 %skip(1);
2851 dcl DECIMAL char (7) static int options (constant) init ("decimal");
2852 dcl DIGITS char (10) static int options (constant) init ("0123456789");
2853 dcl DONT_ALLOW_DUPLICATES bit (1) aligned static int options (constant) init ("0"b);
2854 %skip(1);
2855 dcl EXTENSIBLE bit (1) aligned static int options (constant) init ("1"b);
2856 %skip(1);
2857 dcl FILL char (4) static int options (constant) init ("fill");
2858 %skip(1);
2859 dcl LEFT char (4) static int options (constant) init ("left");
2860 dcl LEFT_BRACKET char (1) static int options (constant) init ("[");
2861 %skip(1);
2862 dcl NINE char (1) static int options (constant) init ("9");
2863 dcl NO_ZERO_ON_ALLOC bit (1) aligned static int options (constant) init ("0"b);
2864 dcl NO_ZERO_ON_FREE bit (1) aligned static int options (constant) init ("0"b);
2865 dcl NON_FREEING bit (1) aligned static int options (constant) init ("1"b);
2866 %skip(1);
2867 dcl OFF bit (1) aligned static int options (constant) init ("0"b);
2868 dcl ON bit (1) aligned static int options (constant) init ("1"b);
2869 %skip(1);
2870 dcl PERMANENT bit (36) aligned static int options (constant) init ("01"b);
2871 %skip(1);
2872 dcl RESET char (5) static int options (constant) init ("reset");
2873 dcl RIGHT char (5) static int options (constant) init ("right");
2874 dcl RUNNING char (7) static int options (constant) init ("running");
2875 %skip(1);
2876 dcl STAR_OR_QUESTION_MARK char (2) static int options (constant) init ("*?");
2877 dcl STAR_DOT_STAR_STAR char (4) static int options (constant) init ("*.**");
2878 %skip(1);
2879 dcl TAB char (1) static int options (constant) init ("      ");
2880 dcl TILDE char (1) static int options (constant) init ("~");
2881 dcl TRUNCATE char (8) static int options (constant) init ("truncate");
2882 %skip(1);
2883 dcl ZERO char (1) static int options (constant) init ("0");
2884 %page;
2885 dcl addr builtin;
2886 dcl after builtin;
2887 %skip(1);
2888 dcl before builtin;
2889 %skip(1);
2890 dcl caktc_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2891 dcl cavgl_save_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2892 dcl char builtin;
2893 dcl code fixed bin (35);
2894 dcl column_map (number_of_defined_columns) bit (1) based (column_map_ptr);
2895 dcl column_map_ptr ptr;
2896 dcl convert builtin;
2897 dcl cv_dec_check_ entry (char(*), fixed bin(35)) returns(fixed bin(35));
2898 %skip(1);
2899 dcl delete_$ptr entry (ptr, bit(6), char(*), fixed bin(35));
2900 dcl directory_name char (168);
2901 dcl divide builtin;
2902 %skip(1);
2903 dcl entry_name char (32);
2904 dcl error_table_$no_s_permission fixed bin(35) ext static;
2905 dcl error_table_$nomatch fixed bin(35) ext static;
2906 dcl error_table_$nostars fixed bin(35) ext static;
2907 dcl error_table_$oldnamerr fixed bin(35) ext static;
2908 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
2909 %skip(1);
2910 dcl fixed builtin;
2911 %skip(1);
2912 dcl general_columns_names_and_values_info_ptr ptr;
2913 dcl general_report_names_and_values_info_ptr ptr;
2914 dcl get_pdir_ entry() returns(char(168));
2915 dcl get_temp_segment_ entry (char(*), ptr, fixed bin(35));
2916 %skip(1);
2917 dcl hbound builtin;
2918 dcl hcs_$make_seg entry (char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35));
2919 dcl hcs_$status_long entry (char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35));
2920 %skip(1);
2921 dcl index builtin;
2922 %skip(1);
2923 dcl 1 judgement_table (number_of_defined_columns) aligned based (judgement_table_ptr),
2924       2 present bit (1),
2925       2 number fixed bin (35);
2926 dcl judgement_table_ptr ptr;
2927 %skip(1);
2928 dcl length builtin;
2929 dcl 1 like_name_value_info (no_of_active_names_and_values) based (like_names_and_values_info_ptr) like name_value_info;
2930 dcl like_names_and_values_info_ptr ptr;
2931 dcl linus_error_$bad_option_identifier fixed bin(35) ext static;
2932 dcl linus_error_$bad_option_name fixed bin(35) ext static;
2933 dcl linus_error_$bad_option_value fixed bin(35) ext static;
2934 dcl linus_error_$no_lila_expr_processed fixed bin(35) ext static;
2935 dcl linus_fr_delete_report entry (ptr, fixed bin(35));
2936 dcl match_star_name_ entry (char(*), char(*), fixed bin(35));
2937 dcl linus_table$info entry (ptr, ptr, fixed bin (35));
2938 dcl long_option_name char (MAXIMUM_OPTION_NAME_LENGTH) varying;
2939 dcl ltrim builtin;
2940 dcl lvswcd_option_identifier char (MAXIMUM_OPTION_IDENTIFIER_LENGTH) varying;
2941 dcl lvswcd_option_name char (MAXIMUM_OPTION_NAME_LENGTH) varying;
2942 dcl lvswcd_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2943 %skip(1);
2944 dcl max builtin;
2945 dcl me char (64);
2946 dcl mdbm_util_$mu_define_area entry (ptr, fixed bin(18), char(11), bit(1) aligned, bit(1) aligned, bit(1) aligned, bit(1) aligned, fixed bin(35));
2947 %skip(1);
2948 dcl names_and_values_area area (sys_info$max_seg_size) based (names_and_values_area_ptr);
2949 dcl names_and_values_area_ptr ptr;
2950 dcl names_and_values_bit_map (no_of_names_and_values_in_bit_map) bit (1) based (names_and_values_bit_map_ptr);
2951 dcl names_and_values_bit_map_ptr ptr;
2952 dcl names_and_values_temp_seg_ptr ptr;
2953 dcl normalized_option_name char (MAXIMUM_NORMALIZED_OPTION_NAME_LENGTH) varying;
2954 dcl no_of_active_names_and_values fixed bin;
2955 dcl no_of_names_and_values_in_bit_map fixed bin;
2956 dcl null builtin;
2957 dcl number_of_defined_columns fixed bin;
2958 %skip(1);
2959 dcl option_identifier char (MAXIMUM_OPTION_IDENTIFIER_LENGTH) varying;
2960 dcl option_name char (MAXIMUM_OPTION_NAME_LENGTH) varying;
2961 dcl option_table_index fixed bin;
2962 dcl option_type fixed bin;
2963 dcl option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2964 %skip(1);
2965 dcl rel builtin;
2966 dcl release_area_ entry (ptr);
2967 dcl release_temp_segment_ entry (char(*), ptr, fixed bin(35));
2968 dcl returned_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2969 dcl rclac_spare_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2970 dcl rslac_original_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2971 dcl rslac_result_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2972 dcl rslac_triplet char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2973 dcl rtrim builtin;
2974 %skip(1);
2975 dcl sci_ptr ptr;
2976 dcl search builtin;
2977 dcl specific_columns_names_and_values_info_ptr ptr;
2978 dcl 1 star_name_info based (star_name_info_ptr),
2979       2 maximum_number_of_star_names fixed bin,
2980       2 number_of_star_names fixed bin,
2981       2 star_name_map (maximum_number_of_star_names) bit (1),
2982       2 column_maps_info (number_of_star_names),
2983         3 number_of_matches fixed bin,
2984         3 column_bit_map (number_of_defined_columns) bit (1);
2985 dcl star_name_info_ptr ptr;
2986 dcl ssu_$abort_line entry() options(variable);
2987 dcl ssu_$print_message entry() options(variable);
2988 dcl substr builtin;
2989 dcl sv_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2990 dcl sv_spare_option_identifier char (MAXIMUM_OPTION_IDENTIFIER_LENGTH) varying;
2991 dcl sv_spare_option_value char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
2992 dcl sys_info$max_seg_size fixed bin(35) ext static;
2993 dcl system_default bit (1) aligned;
2994 %skip(1);
2995 dcl temp_seg_ptr ptr;
2996 dcl translate builtin;
2997 %skip(1);
2998 dcl unspec builtin;
2999 %skip(1);
3000 dcl valid_selection_expression bit (1) aligned;
3001 dcl value_seg_ptr ptr;
3002 dcl value_$delete entry (ptr, bit(36) aligned, char(*), fixed bin(35));
3003 dcl value_$init_seg entry (ptr, fixed bin, ptr, fixed bin(19), fixed bin(35));
3004 dcl value_$get entry() options(variable);
3005 dcl value_$list entry (ptr, bit(36) aligned, ptr, ptr, ptr, fixed bin(35));
3006 dcl value_$set entry() options(variable);
3007 dcl verify builtin;
3008 %skip(1);
3009 %page;
3010 %include access_mode_values;
3011 %page;
3012 %include arg_descriptor;
3013 %page;
3014 %include arg_list;
3015 %page;
3016 %include linus_format_options;
3017 %page;
3018 %include linus_lcb;
3019 %page;
3020 %include linus_names_and_values;
3021 %page;
3022 %include linus_options_extents;
3023 %page;
3024 %include linus_report_info;
3025 %page;
3026 %include linus_table_info;
3027 %page;
3028 %include mdbm_descriptor;
3029 %page;
3030 %include status_structures;
3031 %page;
3032 %include value_structures;
3033 %skip(3);
3034      end linus_options;