1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  13 /* Status                                                                                 */
  14 /*                                                                                        */
  15 /* 0) Created:   November, 1969   by T. H. VanVleck                                       */
  16 /* 1) Modified:  February, 1975   by T. H. VanVleck - complete rewrite                    */
  17 /* 2) Modified:  September,1976   by Steve Herbst - accept -pathname ctl_arg              */
  18 /* 3) Modified:  June, 1977       by Paul Green - diagnose zero-length info segs          */
  19 /* 4) Modified:  October, 1978    by Gary Dixon - complete rewrite; split into help       */
  20 /*                                      command and separate help_ subroutine.            */
  21 /*                                      Add support for check_info_segs.                  */
  22 /* 5) Modified:  April, 1985      by L. Adams - rewrote parsing routines to use line logic*/
  23 /*                                                                                        */
  24 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  25 
  26 /****^  HISTORY COMMENTS:
  27   1) change(1986-03-05,LJAdams), approve(1986-03-05,MCR7327),
  28      audit(1986-04-17,Lippard), install(1986-04-24,MR12.0-1048):
  29      Changed routines to use line parsing.
  30   2) change(1986-05-08,LJAdams), approve(1986-05-14,MCR7416),
  31      audit(1986-06-06,Gilcrease), install(1986-06-12,MR12.0-1074):
  32      Changed sort so that the ep identifier is included.  This is so that
  33      separate infos are maintained for each entry_point is given on the
  34      command line.
  35   3) change(1986-09-04,LJAdams), approve(1986-09-04,MCR7506),
  36      audit(1986-10-29,GDixon), install(1986-10-30,MR12.0-1203):
  37      Moved error messages for no match on srh/section and entry point not
  38      found here to avoid printing duplicate error messages per info seg
  39      found in search path.
  40   4) change(1987-01-20,LJAdams), approve(1987-09-03,MCR7766),
  41      audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109):
  42      Changed to version Vhelp_args_3.
  43   5) change(1988-02-17,LJAdams), approve(1988-03-07,MCR7857),
  44      audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109):
  45      Changed to check the help_args.help_data_ptr to determine if it is a
  46      list_request operation.  This is because when checking the validity of
  47      names the lr operation must allow the (. .. ?) symbols.
  48   6) change(1988-03-14,LJAdams), approve(1988-06-01,MCR7873),
  49      audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109):
  50      Changed VPDinfo_seg_1 to VPDinfo_seg_2.  Changed sort to eliminate
  51      duplicates from sorting 360 bits to sorting 396 bits. (phx21111)
  52   7) change(2020-07-30,GDixon), approve(2021-02-23,MCR10089),
  53      audit(2021-03-31,Swenson), install(2021-03-31,MR12.6g-0053):
  54       A) Rewrote entire help_ program.  User interface changes include:
  55       B) Support new block divider keywords that begin blocks in an info segment.
  56       C) Change default for min_Lpgh from 4 to 15 lines.
  57          Change default for max_Lpgh from 15 to terminal's page length.
  58       D) Add ALL_PARAGRAPHS label constant for use by new all_paragraphs response.
  59       E) For subroutine info seg, -section/-search use find_ep to look for matching
  60          entrypoint, then call section/search response to position within that ep.
  61   8) change(2022-06-06,GDixon), approve(2022-06-06,MCR10101),
  62      audit(2022-07-27,Swenson):
  63      Change help_ to support several single-entrypoint subroutine info blocks
  64      in a single info segment.
  65                                                    END HISTORY COMMENTS */
  66 %page;
  67           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
  68           /*                                                                                                */
  69           /* SUBROUTINE:  help_                                                                             */
  70           /*                                                                                                */
  71           /* This subroutine implements the help command.  It performs the following functions.             */
  72           /*                                                                                                */
  73           /* 1) Finds info segments.                                                                        */
  74           /* 2) Selects particular infos within multi-info segments.                                        */
  75           /* 3) Sorts the list of infos to be processed.                                                    */
  76           /* 4) Processes each info, implementing all help control arguments and query responses.           */
  77           /*                                                                                                */
  78           /* The subroutine may also be used to implement a help-style information facility in              */
  79           /* other subsystems.  Information segments (with an info suffix or another suffix) are            */
  80           /* selected and printed, based upon information given primarily in a help_args structure,         */
  81           /* which is declared in help_args_.incl.pl1.                                                      */
  82           /*                                                                                                */
  83           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
  84 %page;
  85           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
  86           /*                                                                                                */
  87           /* ENTRYPOINT:  help_                                                                             */
  88           /*                                                                                                */
  89           /* This entrypoint builds a list of info segments selected by help_args input data; then sorts    */
  90           /* that list; then walks though the list one item at a time, calling info_seg_ to parse the       */
  91           /* info segment into blocks; then enters the help_ ssu_ request loop to display that parsed info  */
  92           /* segment.                                                                                       */
  93           /*                                                                                                */
  94           /*                                                                                                */
  95           /* Usage                                                                                          */
  96           /*                                                                                                */
  97           /* The help_ subroutine must be invoked by a sequence of calls.                                   */
  98           /*                                                                                                */
  99           /* 1) call help_$init to get temp segment containing help_args structure and stores the           */
 100           /*    current info_segments search rules in the structure.                                        */
 101           /* 2) call help_ one or more times to select and print info segments.                             */
 102           /* 3) call help_$term to release the temp segment.                                                */
 103           /*                                                                                                */
 104           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 105 
 106 help_:
 107      procedure (procedure_name, Phelp_args, suffix, progress, Acode);
 108 
 109   dcl                                                       /*        Parameters                                      */
 110        procedure_name char (*),                             /* Caller of help_ and help_$init.                        */
 111                                                             /*   1) Owns temp segment help_args are stored in.        */
 112                                                             /*   2) Name used in error messages.                      */
 113 /*     Phelp_args      ptr,                                 /* ptr to argument struct returned by help_$init          */
 114                                                             /* This ptr really declared in include seg:               */
 115                                                             /*  help_args_.incl.pl1                                   */
 116        suffix          char (*),                            /* Suffix on segs to be processed. Normally "info"        */
 117                                                             /* but may be some other suffix or "" to omit             */
 118                                                             /* suffix processing.                                     */
 119        progress        fixed bin,                           /* =1: bad help_args version                              */
 120                                                             /* =2: no pathnames given.                                */
 121                                                             /* =3: evaluating pathnames.                              */
 122                                                             /* =4: finding help segs.                                 */
 123                                                             /* =5: -section/-search & printing help segs.             */
 124        Acode           fixed bin (35);                      /* Return code.                                           */
 125 
 126   dcl  PDeps           ptr,
 127        Ptemp           ptr,
 128        fcn             fixed bin,                           /* Function to be performed by this invocation.           */
 129       (
 130        HELP            init (0),                            /*   help_                                                */
 131        CIS             init (1)                             /*   help_$check_info_segs                                */
 132        )               fixed bin int static options (constant),
 133       (i, j)           fixed bin,
 134        offset          fixed bin (35);
 135 
 136   dcl  bit36           bit (36) aligned based,
 137        bit72           bit (72) aligned based,
 138        bit360          bit (360) aligned based;
 139 %page;
 140   dcl (addr, addrel, binary, char, charno, clock, currentsize, dim, dimension, divide, empty, hbound, index, lbound, length,
 141        ltrim, mod, null, ptr, rel, reverse, rtrim, search, string, substr, unspec, verify)
 142                        builtin;
 143 
 144   dcl (cleanup, program_interrupt)
 145                        condition;
 146 
 147   dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)),
 148        get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin),
 149        get_page_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin),
 150        hcs_$get_uid_file entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
 151        hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)),
 152 
 153        help_listen_util_$display_prompt entry (ptr),
 154        help_listen_util_$print_iPgh_range entry (ptr),
 155        help_listen_util_$set_iPgh_range entry (ptr),
 156        help_request_tables_$for_non_subroutine_info entry options(variable),
 157        help_request_tables_$for_subroutine_info entry options(variable),
 158        help_requests_$unknown_response entry (ptr, ptr, char(*), ptr, bit(1) aligned),
 159        help_responses_$lep_setup entry (ptr, ptr),
 160        help_util_$execute entry (ptr, ptr, char(*)),
 161        help_util_$print_section entry (ptr, ptr, ptr),
 162 
 163        info_seg_$examine_iFile entry (ptr, char(*), char(*), bit(36) aligned, fixed bin(35)) returns(ptr),
 164        info_seg_$init_for_help_ entry (ptr, fixed bin(35)),
 165        info_seg_$parse_iFile entry (ptr, ptr),
 166        info_seg_$reinitialize entry (ptr),
 167        info_seg_$terminate entry (ptr),
 168        info_seg_$unthread_iBlok entry (ptr),
 169 
 170        info_seg_util_$count_files entry (ptr) returns (fixed bin),
 171        info_seg_util_$is_Subroutine_kind entry (fixed bin) returns(bit(1) aligned),
 172 
 173        match_star_name_ entry (char (*), char (*), fixed bin (35)),
 174        pathname_$component entry (char (*), char (*), char (*)) returns (char (194)),
 175        release_temp_segment_ entry (char (*), ptr, fixed bin (35)),
 176        search_paths_$get entry (char (*), bit (36), char (*), ptr, ptr, fixed bin, ptr, fixed bin (35)),
 177 
 178        sort_items_$bit entry (ptr, fixed bin),
 179        sort_items_$char entry (ptr, fixed bin),
 180 
 181        ssu_$set_procedure entry (ptr, char(*), entry, fixed bin(35));
 182 
 183 
 184   dcl (error_table_$bad_seg,
 185        error_table_$improper_data_format,
 186        error_table_$inconsistent,
 187        error_table_$incorrect_access,
 188        error_table_$moderr,
 189        error_table_$no_s_permission,
 190        error_table_$noarg,
 191        error_table_$noentry,
 192        error_table_$no_info,
 193        error_table_$nomatch,
 194        error_table_$unimplemented_version,
 195        error_table_$zero_length_seg,
 196        ssu_et_$subsystem_aborted
 197        ) fixed bin (35) ext static,
 198 
 199        iox_$user_input ptr ext static,                      /* Used to obtain input (responses) from the user.        */
 200        iox_$user_output ptr ext static,                     /* Used to check for line and page length of output lines */
 201        iox_$user_io ptr ext static,                         /* Used to check for video-based input.                   */
 202        video_data_$terminal_iocb ptr ext static;
 203 %page;
 204                                                             /* Include file placed here so constants may be           */
 205                                                             /*  referenced in label array values below.               */
 206 %include info_seg_dcls_;
 207 %page;
 208 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 209 
 210      fcn = HELP;                                            /* Perform a help function.                               */
 211      go to HELP_COMMON;
 212 
 213 
 214 
 215           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 216           /*                                                                                                */
 217           /* ENTRYPOINT:  help_$check_info_segs                                                             */
 218           /*                                                                                                */
 219           /* This entrypoint generates the list of info segments to be processed by the                     */
 220           /* check_info_segs command.  It finds info segments modified since a given date, sorts            */
 221           /* the list and returns it for check_info_segs to process.                                        */
 222           /*                                                                                                */
 223           /* Usage                                                                                          */
 224           /*                                                                                                */
 225           /* 1) call help_$init to get temp segment containing help_args and the output list.               */
 226           /* 2) call help_$check_info_segs to build and sort the list of segments to be processed.          */
 227           /* 3) call help_$term to release the temp segment.                                                */
 228           /*                                                                                                */
 229           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 230 
 231 check_info_segs:
 232      entry (procedure_name, Phelp_args, suffix, progress, Acode, APPDinfo_seg);
 233 
 234   dcl  APPDinfo_seg    ptr;                                 /* Ptr to output structure returned by                    */
 235                                                             /*   help_$check_info_segs                                */
 236 
 237      fcn = CIS;                                             /* Perform a check_info_segs function.                    */
 238      APPDinfo_seg = null();                                 /*  - initialize output argument for this function.       */
 239 
 240 
 241 /* --------------------------------------------------------------------------------
 242    progress = 1:  Check version of help_args input structure.
 243    -------------------------------------------------------------------------------- */
 244 
 245 HELP_COMMON:
 246      progress = 1;
 247      Acode = 0;                                             /* Initialize error code.                                 */
 248 
 249      if  help_args.version = 1 | help_args.version = 2  then do
 250           help_args.version = Vhelp_args_3;                 /*  - Ver 1 and 2 are upwards-compatible with 3 by setting*/
 251           help_args.sci_ptr = null;                         /*    variables added in later versions to their default  */
 252           help_args.help_data_ptr = null;                   /*    values.                                             */
 253           help_args.Sctl.inhibit_errors = F;
 254           end;
 255      if  help_args.version ^= Vhelp_args_3  then do;        /*  - Report error if unsupported version.                */
 256           Acode = error_table_$unimplemented_version;
 257           return;
 258           end;
 259 
 260 
 261 /* --------------------------------------------------------------------------------
 262    progress = 2:  Check that info seg paths (input data for this call) were given.
 263    -------------------------------------------------------------------------------- */
 264 
 265      progress = 2;                                          /* Make sure info file names were given.                  */
 266      if  help_args.Npaths ^> 0  then do;
 267           Acode = error_table_$noarg;
 268           return;
 269           end;
 270 
 271 
 272 /* --------------------------------------------------------------------------------
 273    progress = 3:
 274     A) Access help_info (hi) and info_seg_data (isd) structures.
 275     B) Adjust temp segment hi.next_free_spaceP based on current size of
 276        help_args structure.  Presumably, caller added path(*) array
 277        elements.
 278     C) Evaluate input help_args.path(*) for incorrect usage errors.
 279    -------------------------------------------------------------------------------- */
 280 
 281      progress = 3;                                          /* Access hidden help_info structure, and other           */
 282                                                             /*  structures that precede help_args in temp seg         */
 283                                                             /*  (see _help_shared_data_.incl.pl1)                     */
 284                                                             /* Then evaluate input paths...                           */
 285 
 286      help_infoP = ptr (Phelp_args, 0);                      /*  - Structure at Position 1 in temp seg.                */
 287      hi.help_ptrs = null();                                 /*     - remove storage from any previous help_ call.     */
 288      hi.help_labels = SUBSYSTEM_ABORTED;                    /*     - provide some value for pi/abort labels.          */
 289      hi.help_numbers = 0;
 290      hi.info_ptrs = null();
 291      hi.info_switches = F;
 292 
 293 /*dcl 1 isd aligned like info_seg_data based (hi.isdP);     /*  - Structure at Position 2 in temp seg                 */
 294                                                             /*     - setting help_infoP makes hi.isdP accessible.     */
 295                                                             /*     - isd is really setup in help_$init, which         */
 296                                                             /*       prepares this structure for calls to             */
 297                                                             /*       info_seg_$init_for_help_                         */
 298 
 299      hi.next_free_spaceP = Phelp_args;                      /*  - Structure at Position 3 in temp seg.                */
 300                                                             /*     - Phelp_args should be exact value returned to     */
 301                                                             /*       caller of help_$init                             */
 302      call set_space_used (currentsize (help_args));         /*     - reset hi.next_free_spaceP w/ current help_args   */
 303                                                             /*       size.                                            */
 304 
 305 
 306      do i = 1 to help_args.Npaths;                          /*  - Examine/expand/evaluate input paths.                */
 307           call evaluate_path (help_args.path (i), suffix);
 308           if Acode = 0 then                                 /*     - no errors found earlier?                         */
 309                Acode = help_args.path.code (i);             /*        - return first error that occurs, so caller     */
 310           end;                                              /*          knows there are errors.  Caller responsible   */
 311      if Acode ^= 0 then                                     /*          for displaying any errors in                  */
 312           return;                                           /*          help_args.path.code(i) elements.              */
 313 
 314 %page;
 315 /* --------------------------------------------------------------------------------
 316    progress = 4: Prepare to do directory searching, and to look inside
 317                  found info segments for any info blocks they may contain.
 318    -------------------------------------------------------------------------------- */
 319 
 320      progress = 4;                                          /* From here on, help_ exits by restoring help_args       */
 321                                                             /*  temp segment to its length when help_ was called.     */
 322                                                             /* help_$check_info_segs returns with structures in the   */
 323                                                             /*  temp segment after the help_args structure.           */
 324 
 325      hi.help_numbers.terminal_lineL = min (HELP_LINE_SIZE_MAX, get_line_length_$switch (iox_$user_output, code));
 326      if code ^= 0 then
 327           hi.terminal_lineL = HELP_LINE_SIZE_DEFAULT;       /* Get user's terminal line size.                         */
 328      if  ^help_args.Sctl.no_video  &  video_data_$terminal_iocb ^= null()  then
 329           hi.video_iocbP = iox_$user_io;                    /* Setup for prompt/response overwrite if video_invoked   */
 330      else hi.video_iocbP = null();                          /*  No overwrite if -no_video or [not [wdc video_invoked]]*/
 331      hi.prompt_region = 0;
 332      hi.clear_prompt_regionS = F;
 333      hi.help_video_data.hvd_pad = F;
 334 
 335      hi.help_numbers.infos_printedN = 0;                    /*  - No info segs printed so far.                        */
 336                                                             /*      (tested at EXIT_NO_MATCH label below)             */
 337      hi.help_numbers.newline_Nblanks_output = 0;            /*  - No newlines emitted yet.                            */
 338 
 339      if  fcn = HELP  &  isd.areaP = null()  then do;        /* Prepare to parse info segs into one or more blocks.    */
 340                                                             /*  - Init not needed now if done in prior call to help_. */
 341                                                             /*     (info_seg_$init_for_help_ sets isd.areaP non-null) */
 342                                                             /*  - info_seg_ is not used by: help_$check_info_segs     */
 343                                                             /*      (fcn = CIS)                                       */
 344           call info_seg_$init_for_help_ (addr (isd), Acode);
 345           if  Acode ^= 0  then                              /*      Note: isd storage was setup by help_$init         */
 346                return;
 347           end;
 348 
 349 /* -----------------------------------------------------------------
 350    Directory search generates a Dinfo structure stored in temp seg
 351     (after help_args structure).
 352    Subsequent call to parse info seg into blocks adds one
 353      Dinfo.seg(I) array element for each matching info block.
 354       - For purposes of Dinfo structure, a subroutine info w/ :Entry:
 355         dividers is treated as a "single block describing the subroutine".
 356    ----------------------------------------------------------------- */
 357 
 358     hi.Dinfo_arrayP, PDinfo = hi.next_free_spaceP;          /*  - Structure at Position 4 in temp seg.                */
 359                                                             /*     - Get space (after help_args) for Dinfo structure  */
 360                                                             /*     PDinfo and Dinfo are declared in:                  */
 361                                                             /*        _help_shared_data_.incl.pl1  &                  */
 362                                                             /*        help_cis_args_.incl.pl1                         */
 363 
 364     Dinfo.N = 0;                                            /*  - Dinfo.seg(I) items start as info seg descriptions   */
 365                                                             /*    (1 or more for each help_args.path(*) item).        */
 366 
 367     do i = 1 to help_args.Npaths;                           /*  - Star convention and info_seg search paths means     */
 368                                                             /*    each info path can add several Dinfo.seg(I) items.  */
 369                                                             /*    Each .seg(I) is then expanded to include one        */
 370                                                             /*    .seg(I) item for each matching info block found in  */
 371                                                             /*    one of those info segs.                             */
 372 
 373          if  help_args.path (i).S.less_greater              /*     - dir components given in help_args.path(i)?       */
 374           |  help_args.Nsearch_dirs = 0  then               /*      OR caller gave no info search paths?              */
 375               call get_info_seg_list (suffix, fcn, help_args.path (i).dir (*), help_args.path (i), PDinfo);
 376                                                             /*        - don't use info_segs (or other) search paths   */
 377          else call get_info_seg_list (suffix, fcn, help_args.search_dirs (*), help_args.path (i), PDinfo);
 378          end;                                               /*        - do use info_segs (or other) search paths.     */
 379 
 380     if  Dinfo.N <= 0  then                                  /*  - Stop if no matching Dinfo_seg (blocks) were found.  */
 381          go to EXIT_NO_MATCH;
 382     call set_space_used ( currentsize (Dinfo) );            /* Record space used for Dinfo structure in temp segment. */
 383 
 384 %page;
 385 /* --------------------------------------------------------------------------------
 386    progress = 5:  Create an array of pointers to Dinfo.seg(I) items that can be sorted
 387                   based on values at various offsets within each Dinfo.seg(I) structure.
 388    -------------------------------------------------------------------------------- */
 389 
 390      progress = 5;                                          /* Infos selected by starname.  Any other errors          */
 391                                                             /*  reported via Acode describe info selection by         */
 392                                                             /*  -search and -section criteria (done below).           */
 393 
 394      hi.Dinfo_sort_ptrsP, PPDinfo_seg = hi.next_free_spaceP;/*  - Structure at Position 5 in temp seg.                */
 395                                                             /*     PDinfo_seg is declared in help_cis_args_.incl.pl1  */
 396 
 397      PDinfo_seg.version = VPDinfo_seg_3;                    /* PDinfo_seg is returned by help_$check_info_segs so it  */
 398                                                             /*  has: a .version element.                              */
 399      PDinfo_seg.N = Dinfo.N;                                /*       a .N element: count of ptrs returned.            */
 400                                                             /*       a .P element: points to each Dinfo.seg(*) item.  */
 401                                                             /*     - these pointers get sorted by next steps.         */
 402 
 403                               /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 404                               /*                                                                    */
 405                               /* Sort pointers to found blocks three times:                         */
 406                               /*  1st:  sort on  Dinfo.seg.uid/.I/.E/.X  combo to detect duplicate  */
 407                               /*        infos.  Duplicates are eliminated from list.                */
 408                               /*  2nd:  sort on Dinfo.seg.ent to identify versions of info seg in   */
 409                               /*        different dirs.                                             */
 410                               /*  3rd:  sort on Dinfo.seg.Scross_ref/.ent combination to            */
 411                               /*        alphabetize output.                                         */
 412                               /*                                                                    */
 413                               /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 414 
 415      if  Dinfo.N = 1  then                                  /*   Skip sorting if only 1 info seg/block was found.     */
 416           PDinfo_seg.P (1) = addr (Dinfo.seg (1).ent);
 417 
 418      else                                                   /*   1st:  sort on  Dinfo.seg.uid/.I/.E/.X combo          */
 419 SORT_STEP_1:                                                /*         to detect duplicate infos.                     */
 420      do;
 421           do i = 1 to Dinfo.N;
 422                PDinfo_seg.P (i) = addr (Dinfo.seg (i).uid); /*   - point to Dinfo.seg.uid of array element            */
 423                Dinfo.seg (i).X = i;                         /*   - .X indicates order in which blocks were found      */
 424                end;                                         /*     relative to help_args.paths input specification,   */
 425                                                             /*     & order of help_args.search_dirs (info_segs paths) */
 426 
 427           call sort_items_$bit (addr (PDinfo_seg.N), 11 * BITS_PER_WORD);
 428                                                             /*   - Sort on content of 11 words starting at            */
 429                                                             /*     Dinfo.seg(*).uid :  1 for uid                      */
 430                                                             /*                         1 for block offset w/in info   */
 431                                                             /*                         8 for info seg entryname       */
 432                                                             /*                         1 for order found by search    */
 433 
 434           offset = binary (rel (addr (Dinfo.seg (1).ent))) - binary (rel (addr (Dinfo.seg (1).uid)));
 435                                                             /*  - Compute offset to change pointers from              */
 436                                                             /*    Dinfo.seg.uid to point to Dinfo.seg.ent             */
 437 
 438           do i = 1 to Dinfo.N while (PDinfo_seg.P (i) -> bit72 = "0"b);
 439                PDinfo_seg.P (i) = addrel (PDinfo_seg.P (i), offset);
 440                end;                                         /* Adjust offset in ERROR entries.  These have duplicate  */
 441                                                             /*  .uid/.I combos (zero bits set when error detected).   */
 442                                                             /*  Avoid eliminating these duplicates so the             */
 443                                                             /*  errors can be reported.  The 1st sort call (above)    */
 444                                                             /*  moved pointers to such error items to top of list.    */
 445 
 446           if i > Dinfo.N then                               /* If all info segs are in error, skip the                */
 447                go to SKIP_ELIMINATION;                      /*  elimination of duplicates.                            */
 448           j = i - 1;                                        /* j+1 will be index of pointer to retained items in      */
 449                                                             /*  the CHECK(i) code below.                              */
 450 
 451           go to CHECK (fcn);                                /* Checking differs by help_ entrypoint.                  */
 452 
 453 CHECK (HELP):
 454           do i = i to Dinfo.N - 1;                          /* Eliminate duplicate .uid/.I/.E combos for non-errant   */
 455                                                             /*  Dinfo.seg(I) items.                                   */
 456                if  PDinfo_seg.P (i) -> bit360 ^= PDinfo_seg.P (i + 1) -> bit360  then do;
 457                     j = j + 1;                              /*   (Only retain unique .uid/.I/.E combos.)              */
 458                     PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset);
 459                     end;
 460                else PDinfo_seg.P (i + 1) = PDinfo_seg.P (i);
 461                end;                                         /*   (Retain info found earliest in search rules).        */
 462           go to END_CHECK;
 463 
 464 CHECK (CIS):
 465           do i = i to Dinfo.N - 1;                          /* Eliminate duplicate .uid combos.                       */
 466                if  PDinfo_seg.P (i) -> bit36 ^= PDinfo_seg.P (i + 1) -> bit36  then do;
 467                     j = j + 1;                              /*   (Only retain unique .uid combos.)                    */
 468                     PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset);
 469                     end;
 470                else PDinfo_seg.P (i + 1) = PDinfo_seg.P (i);
 471                end;                                         /*   (Retain info found earliest in search rules).        */
 472 
 473 END_CHECK:
 474           j = j + 1;                                        /*   (Always retain the last entry in the list.)          */
 475           PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset);
 476           PDinfo_seg.N = j;                                 /*   Reset count of pointers to those being retained.     */
 477 
 478           end SORT_STEP_1;
 479 
 480 %page;
 481 SKIP_ELIMINATION:                                           /*   2nd:  sort on Dinfo.seg.ent to identify              */
 482                                                             /*         versions of info seg in different dirs.        */
 483 
 484      call set_space_used ( currentsize(PDinfo_seg) );       /* Record space used by PDinfo_seg structure in temp seg  */
 485                                                             /*  now that duplicates have been eliminated.             */
 486 
 487      if  PDinfo_seg.N = 1  then do;
 488           PDinfo_seg.P (1) = addr (Dinfo.seg (1).Scross_ref);
 489           goto SORT_END;
 490           end;
 491 
 492      else
 493 SORT_STEP_2:
 494      do;                                                    /* Sort alphabetically by ent to identify info            */
 495                                                             /*  segments appearing in more than one search dir.       */
 496           call sort_items_$char (addr (PDinfo_seg.N), length(Dinfo.seg (1).ent) );
 497 
 498           offset = binary (rel (addr (Dinfo.seg (1).Scross_ref))) - binary (rel (addr (Dinfo.seg (1).ent)));
 499                                                             /* Compute offset to change pointers from                 */
 500                                                             /*   Dinfo.seg.ent to point to Dinfo.seg.Scross_ref       */
 501 
 502           PDinfo_seg.P (1) = addrel (PDinfo_seg.P (1), offset);
 503           do i = 1 to Dinfo.N - 1;                          /* Check for entry of same name in different dirs.        */
 504                PDinfo_seg.P (i + 1) = addrel (PDinfo_seg.P (i + 1), offset);
 505                if  PDinfo_seg.P (i) -> Dinfo_seg.ent  = PDinfo_seg.P (i + 1) -> Dinfo_seg.ent
 506                  & PDinfo_seg.P (i) -> Dinfo_seg.uid ^= PDinfo_seg.P (i + 1) -> Dinfo_seg.uid
 507                  & PDinfo_seg.P (i) -> Dinfo_seg.uid ^= "0"b  &  "0"b ^= PDinfo_seg.P (i + 1) -> Dinfo_seg.uid  then do;
 508                                                             /* Mark all but entry found earliest in search            */
 509                                                             /*  rules with a cross reference flag.                    */
 510 
 511                     if  binary (rel (PDinfo_seg.P (i)), 18) < binary (rel (PDinfo_seg.P (i + 1)), 18)  then do;
 512                          Ptemp = PDinfo_seg.P (i);          /*  - Swap to make ptr to first found item later in list. */
 513                          PDinfo_seg.P (i) = PDinfo_seg.P (i + 1);
 514                          PDinfo_seg.P (i + 1) = Ptemp;
 515                          end;
 516                     PDinfo_seg.P (i) -> Dinfo_seg.Scross_ref = T;
 517                     end;                                    /*  - Turn on Scross_ref in dup item (now lowest in list) */
 518                end;
 519           end SORT_STEP_2;
 520 
 521 SORT_STEP_3:
 522      if PDinfo_seg.N > 1 then                               /*   3rd:  sort on Dinfo.seg.Scross_ref/.ent              */
 523                                                             /*         combination to alphabetize output.             */
 524           call sort_items_$char (addr (PDinfo_seg.N),
 525                                  CHARS_PER_WORD + length(Dinfo.seg (1).ent) );
 526 
 527 
 528 SORT_END:
 529      if  fcn = CIS  then do;
 530           APPDinfo_seg = PPDinfo_seg;                       /* Return pointer to PDinfo_seg to help_$check_info_segs  */
 531           return;                                           /*  caller.                                               */
 532           end;
 533 %page;
 534                                                             /* help_$help_ continues processing...                    */
 535      call ssu_$set_prompt_mode (hi.sciP, DONT_PROMPT);      /*  - Disable ssu_ prompting...                           */
 536 
 537      call ssu_$set_procedure (hi.sciP, "pre_request_line", help_listen_util_$display_prompt, code);
 538                                                             /*  - help_ does its own prompts with info section titles */
 539      if  code ^= 0  then do;                                /*    and "More help?" query.                             */
 540           call error (hi.sciP, code, "Replacing ssu_ pre_request_line procedure.");
 541           goto SUBSYSTEM_ABORTED;
 542           end;
 543 
 544      call ssu_$set_procedure (hi.sciP, "post_request_line", help_listen_util_$print_iPgh_range, code);
 545                                                             /*  - help_ is called by ssu_$listen to actually display  */
 546      if  code ^= 0  then do;                                /*    "selected" info block paragraphs.                   */
 547           call error (hi.sciP, code, "Replacing ssu_ post_request_line procedure.");
 548           goto SUBSYSTEM_ABORTED;
 549           end;
 550 
 551      call ssu_$set_procedure (hi.sciP, "unknown_request", help_requests_$unknown_response, code);
 552                                                             /*  - help_ diagnoses "Unknown request ..." as an         */
 553      if  code ^= 0  then do;                                /*    "Unknown response ..."                              */
 554           call error (hi.sciP, code, "Replacing ssu_ unknown_request procedure.");
 555           goto SUBSYSTEM_ABORTED;
 556           end;
 557 
 558 
 559      hi.PI_LABEL = PROCESS;                                 /* Establish pi handler: enter PROCESS loop               */
 560 
 561      on program_interrupt begin;
 562           hi.print_inhibitS = T;                            /* Tell help_ to stop printing stuff about current info   */
 563           go to hi.PI_LABEL;                                /*  block, and branch to code for next "More help?"       */
 564           end;                                              /*  prompt (or display of next info segment).             */
 565 
 566      call ssu_$set_procedure (hi.sciP, "program_interrupt", help_program_interrupt_, code);
 567      if  code ^= 0  then do;                                /* Tell ssu_listen_ to use our program_interrupt handler. */
 568           call error (hi.sciP, code, "Replacing ssu_ program_interrupt procedure.");
 569           goto SUBSYSTEM_ABORTED;
 570           end;
 571 
 572           help_program_interrupt_:                          /* Procedure passed to ssu_$set_procedure to replace the  */
 573                procedure (AsciP);                           /*  "program_interrupt" handler of ssu_$listen.           */
 574 
 575             dcl  AsciP ptr;                                 /* This is the ssu_ control info ptr, which it ignores.   */
 576                                                             /*  All data referenced via entry variable's display ptr. */
 577 
 578                hi.print_inhibitS = T;                       /* Tell help_ to stop printing stuff about current info   */
 579                hi.prompt_repeatS = T;                       /*  block, and to displaynext "More help?" prompt.        */
 580 
 581                                                             /* This procedure returns to ssu_$listen handler, which   */
 582                                                             /*  branches to its READ_REQUEST label, which calls the   */
 583                                                             /*  pre-request-line procedure as its first action.       */
 584                end help_program_interrupt_;                 /*  That proc is our help_listen_util_$display_prompt     */
 585 
 586 
 587 %page;
 588   dcl 1 saved aligned,
 589       2 (blokP, fileP, firstP, lastP, prevP, nextP)  ptr;
 590 
 591 PROCESS:
 592      code = 0;
 593 WALK_POINTERS_TO_INFO_BLOCKS:
 594      do i = 1 to PDinfo_seg.N while (code = 0);             /* Process each listed info in alphabetical order.        */
 595 
 596           hi.PI_LABEL, hi.NEXT_INFO_LABEL = NEXT_INFO;      /*  - Once inside PROCESS loop, pi jumps to NEXT_INFO     */
 597                                                             /*    "next" response also jumps to NEXT_INFO             */
 598 
 599           saved = null;                                     /*     Nothing stored in "saved" pointers.  Any saving in */
 600                                                             /*     this loop will be un-"saved" at NEXT_INFO label.   */
 601 
 602           hi.info_ptrs = null();                            /* Setup environment for processing new info block.       */
 603 
 604           if  hi.display_mode ^= DISPLAY_MODE_unset  then do;
 605                                                             /* Remove use of any prior ssu_ request table.            */
 606                if  hi.display_mode = DISPLAY_MODE_non_subroutine  then
 607                     call ssu_$delete_request_table (hi.sciP, addr(help_request_tables_$for_non_subroutine_info), code);
 608                else if  hi.display_mode = DISPLAY_MODE_subroutine  then
 609                     call ssu_$delete_request_table (hi.sciP, addr(help_request_tables_$for_subroutine_info), code);
 610                hi.display_mode = DISPLAY_MODE_unset;
 611                end;
 612 
 613           hi.Dinfo_sort_ptrsI = i;                          /*  - Record index of PDinfo_seg.P we're using now, so    */
 614                                                             /*    responses know index of Dinfo_item being displayed. */
 615 
 616           hi.DinfoP = PDinfo_seg.P (i);                     /*  - Save pointer to selected Dinfo_item being displayed.*/
 617 
 618           if  Dinfo_item.code ^= 0  then                    /* Print any error encountered finding info seg/block     */
 619                go to INFO_ERROR;
 620 
 621 
 622           if  info_seg_util_$count_files (addr (isd)) > 10  then
 623 REINITIALIZE:  call info_seg_$reinitialize (addr (isd));    /* Avoid having more than 10 info segs initiated          */
 624 
 625           iFileP =                                          /* Get threaded list of blocks in this info seg.          */
 626                info_seg_$examine_iFile (addr (isd), Dinfo_item.dir, Dinfo_item.ent, Dinfo_item.uid,
 627                                         Dinfo_item.code);   /*   NOTE: This finds/re-uses the blocks parsed in prior  */
 628                                                             /*         call to info_seg_$examine_iFile (in            */
 629                                                             /*         get_info_seg_list) if fewer than 10 info segs  */
 630                                                             /*         are in the list.  But if info_seg_$reinitialize*/
 631                                                             /*         has released that earlier storage, this call   */
 632                                                             /*         reparses the info seg.                         */
 633 
 634           if  iFileP = null ()  &                           /* No iFile returned but got other iFiles earlier         */
 635               isd.files.firstP ^= null ()  then
 636                go to REINITIALIZE;                          /*  - Release storage for prior files so this             */
 637                                                             /*    new file can be processed.                          */
 638 
 639           if  iFileP = null()  then do;                     /*  - Info seg parse failure.  (Highly unlikely!)         */
 640                Dinfo_item.code = error_table_$improper_data_format;
 641                go to INFO_ERROR;
 642                end;
 643 
 644           call info_seg_$parse_iFile (addr (isd), addr (iFile));
 645                                                             /* Complete parsing each info block into sections and     */
 646                                                             /*  paragraphs.                                           */
 647 
 648           iBlokP = iFile.bloks.lastP;                       /*   - Unthread any history comment block from list.      */
 649           if iBlokP ^= null () then                         /*     NOTE: history comment may have been unthreaded     */
 650           if iBlok.divider = iBlok_divider_hcom  |          /*           during prior call to info_seg_$examine_iFile */
 651              iBlok.divider = iBlok_divider_hcom_obsolete    /*           in get_info_seg_list_ procedure.  But that   */
 652           then                                              /*           $examine_iFile data could have been released */
 653                call info_seg_$unthread_iBlok (iBlokP);      /*           by an info_seg_$reinitialize call.           */
 654 
 655 
 656           go to INFO_STRUCT (iFile.structure);              /*  Range of iFile.structure values checked by earlier    */
 657                                                             /*  call to get_info_seg_list.                            */
 658 
 659 INFO_STRUCT (iFile_structure_INFO_HCOM):                    /* Seg with :Info: or :[Info]: dividers.                  */
 660 INFO_STRUCT (iFile_structure_INFO):
 661           do iBlokP = iFile.bloks.firstP                    /*  - Find iBlok referenced by Dinfo_item.                */
 662                repeat iBlok.sib.nextP  while (iBlokP ^= null() );
 663                if  charno(iBlok.P) = Dinfo_item.I  then do; /*  - Display that block.                                 */
 664 
 665                     if  info_seg_util_$is_Subroutine_kind (iBlok.kind)  then do;
 666                                                             /*    If this is a single-entrypoint subroutine in a      */
 667                                                             /*    seg possibly documenting other single-entrypoint    */
 668                                                             /*    subroutines...                                      */
 669 
 670                          saved.blokP = iBlokP;              /*    temporarily unthread any other blocks.              */
 671                          saved.fileP = iFileP;
 672 
 673                          saved.firstP = iFile.bloks.firstP;
 674                          saved.lastP  = iFile.bloks.lastP;
 675                          iFile.bloks.firstP, iFile.bloks.lastP = iBlokP;
 676 
 677                          saved.prevP = iBlok.sib.prevP;
 678                          saved.nextP = iBlok.sib.nextP;
 679                          iBlok.sib.prevP, iBlok.sib.nextP = null();
 680                          end;
 681 
 682                     call display_block();                   /*    Display the selected block.                         */
 683                     go to NEXT_INFO;
 684                     end;
 685                end;
 686           Dinfo_item.code = error_table_$noentry;           /* Matching iBlok not found.  It was there when           */
 687           go to INFO_ERROR;                                 /*  get_info_seg_list just referenced it...               */
 688 
 689 INFO_STRUCT (iFile_structure_NO_DIVIDERS):                  /* Seg with no dividers.
 690           iBlokP = iFile.bloks.firstP;                      /*  - Display the only block in the info segment.         */
 691           call display_block();                             /*    NOTE: This could be single-entrypoint subroutine    */
 692           go to NEXT_INFO;                                  /*          like match_star_name_$match_star_name_;       */
 693                                                             /*          display_block will decide.                    */
 694 
 695 
 696 INFO_STRUCT (iFile_structure_INFO_SUBROUTINE_HCOM):         /* Seg with :Entry: dividers.                             */
 697 INFO_STRUCT (iFile_structure_INFO_SUBROUTINE):
 698 INFO_STRUCT (iFile_structure_SUBROUTINE):
 699           iBlokP = iFile.bloks.firstP;                      /*  - Display subroutine intro block if no entrypoint     */
 700           if  Dinfo_item.ep = ""  then do;                  /*    name was given.                                     */
 701                call display_block();
 702                go to NEXT_INFO;
 703                end;
 704 
 705   dcl  epI fixed bin;                                       /*  - Search for :Entry: block matching entrypoint name.  */
 706           do iBlokP = iBlok.sib.nextP
 707                repeat iBlok.sib.nextP  while (iBlokP ^= null() );
 708                do epI = lbound(Blok_names,1) to hbound(Blok_names,1);
 709                     if  Blok_names(epI) = Dinfo_item.ep  then do;
 710                          call display_block();
 711                          go to NEXT_INFO;
 712                          end;
 713                     end;
 714                end;
 715 
 716           Dinfo_item.code = error_table_$noentry;           /*  - Report error if no block for given entrypoint name. */
 717           call error (hi.sciP, Dinfo_item.code,
 718                " Looking for entry point: ^a^/   in ^[link^;segment^;directory^]: ^a^[>^]^a",
 719                Dinfo_item.ep,
 720                binary (Dinfo_item.segment_type, 2) + 1,
 721                Dinfo_item.dir, Dinfo_item.dir ^= ">", Dinfo_item.ent);
 722           hi.infos_printedN = hi.infos_printedN + 1;        /*     -  error about info counts as "printing it".       */
 723           go to NEXT_INFO;
 724 
 725 
 726 INFO_ERROR:
 727           call error (hi.sciP, Dinfo_item.code,
 728                " ^[Looking for an info block matching: ^a^/   in^;^sFor^] ^[link^;segment^;directory^]: ^a^[>^]^a",
 729                (Dinfo_item.info_name ^= ""), Dinfo_item.info_name,
 730                binary (Dinfo_item.segment_type, 2) + 1,
 731                Dinfo_item.dir, Dinfo_item.dir ^= ">", Dinfo_item.ent);
 732                                                             /*     -  error about info IS NOT "printing it".          */
 733                                                             /*        Do NOT increment hi.infos_printedN here!        */
 734                                                             /*        That breaks multi-call of help_ in probe/mbuild */
 735 
 736 NEXT_INFO:                                                  /* This label is used by help_'s "next" response routine. */
 737           hi.next_free_spaceP = addr(PDinfo_seg);           /* Release space used to display last info from temp seg. */
 738           call set_space_used ( currentsize(PDinfo_seg) );  /* Record space used by PDinfo_seg structure in temp seg  */
 739                                                             /*  to make hi.next_free_spaceP point to the doubleword   */
 740                                                             /*  after the PDinfo_seg array.                           */
 741 
 742           if  saved.blokP ^= null()  then do;               /* Before processing NEXT_INFO argument...                */
 743                                                             /*  Redo any "saved" block threads which were unthreaded. */
 744                saved.fileP->iFile.bloks.firstP = saved.firstP;
 745                saved.fileP->iFile.bloks.lastP  = saved.lastP;
 746                saved.blokP->iBlok.sib.prevP = saved.prevP;
 747                saved.blokP->iBlok.sib.nextP = saved.nextP;
 748                saved = null();                              /*  Clear "saved" pointers for later re-use.              */
 749                end;
 750 
 751           end WALK_POINTERS_TO_INFO_BLOCKS;
 752 
 753 SUBSYSTEM_ABORTED:                                          /* This exit is used by help_'s "quit" response.          */
 754 EXIT_NO_MATCH:                                              /* This exit is used only by fcn = HELP.                  */
 755      if hi.infos_printedN = 0 then                          /* -section and -search didn't find any match.            */
 756           Acode = error_table_$nomatch;
 757 
 758      if  isd.areaP ^= null()  then                          /* Terminate all info segments, and cleanup storage used  */
 759           call info_seg_$reinitialize (addr(isd));          /*  by the info_seg_ facility.                            */
 760 
 761      hi.next_free_spaceP = hi.help_argsP;                   /* Remove temp seg data beyond the current help_args      */
 762      call set_space_used ( currentsize(help_args) );        /*  structure.                                            */
 763      call hcs_$truncate_seg (Phelp_args, binary (rel (Phelp_args)) + currentsize (help_args), 0);
 764                                                             /* help_ is now ready to be called again.                 */
 765 
 766      return;                                                /* This is the main return from help_$help_ to its caller */
 767 
 768 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 769 %page;
 770 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
 771 /*                                                                                                                    *
 772   ORDER OF PROCESSING help_args.Sctl arguments:           [taken from earlier version of help_ routine: help_rql_.pl1]
 773 
 774    - Some help_args values continue selection of which info blocks to display;
 775      they examine info block attributes and/or contents.  These include:
 776 
 777      help_args
 778       .min_date_time mostly ignored by help_$help_;  help_$init disables this test; never set by help.pl1).
 779 
 780 
 781       .Sctl.scn:     copy -section args to local storage \  arg values become defaults if 1st...Ith response given
 782       .Sctl.srh      copy -search args to local storage  /   w/o args.  Each time args are given, the new args become
 783                                                              defaults for later responses given without args.
 784        for hi.display_mode =
 785            non_subroutine: If block does not have any section with title matching a -section STR; and/or
 786                            if block does not have any paragraph matching a -search STR ...
 787                             then that block is totally ignored by display_block (see below).
 788                             If a second instance of file was found later in info_seg search paths,
 789                             that file is promoted to primary candidate and is also tested for
 790                             matching the -section titles and/or -search paragraphs.
 791 
 792                subroutine: With no  entrypoint name given (ie, iBlok points to subr intro block):
 793                             then select an :Entry: block by searching through all :Entry: blocks
 794                             looking for -section/search match.  First matching block is selected for display.
 795                             If no matching :Entry: block found, display subroutine intro block ignoring -section/-search.
 796                            With specific entrypoint given:
 797                             then -section/search applies only to that :Entry: block as described for non-subroutine block.
 798 
 799 
 800    - Other help_args values control how info block is displayed...
 801 
 802       .Sctl.he       Display only a header for selected info block.
 803 
 804 
 805       .Sctl.bf       Display only brief summary of Syntax, Arguments, Control arguments and List of ... sections.
 806                      For hi.display_mode = subroutine, this control arg is ignored unless an :Entry: block is selected.
 807 
 808       .Sctl.ca       Display only description of matching Argument, Control argument or List of ... items.
 809                      For hi.display_mode = subroutine, this control arg is ignored unless an :Entry: block is selected.
 810 
 811       .Sctl.lep:     Ignored for hi.display_mode = non_subroutine.
 812                      For hi.display_mode = subroutine:
 813                       create and print list of entrypoint names for any subroutine block.  Then prompt
 814                       user before displaying subroutine introduction block, so user may use ep request
 815                       to select a subr_$entrypoint block to display instead.
 816                       [NOTE: If -lep is not given, the subr_ introduction block is displayed automatically
 817                              (along with a list of entrypoints), then the user is prompted.  Thus,
 818                              -lep suppresses auto-display of subr_ introduction.]
 819 
 820 
 821       .Sctl.all:     Display without prompting user...
 822 
 823        for hi.display_mode =
 824            non_subroutine: all lines in current block
 825 
 826                subroutine: with no  entrypoint name given:  all intro and Entry blocks;
 827                            with specific entrypoint given:  all lines for that :Entry: block.
 828 
 829 
 830       .Sctl.title    Display section titles of current block.  Then prompt for first section(s) of block.
 831 /*                                                                                                                    *
 832 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 833 %page;
 834           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 835           /*                                                                                                */
 836           /* INTERNAL PROCEDURE:  display_block                                                             */
 837           /*                                                                                                */
 838           /*  REFERENCES caller-supplied variables instead of parameters:                                   */
 839           /*   help_infoP     points to help_info (hi) structure containing global help_ information.       */
 840           /*   hi.DinfoP      points to Dinfo_item structure for current item in "selected info blocks".    */
 841           /*   iFileP         points to iFile structure for info seg containing block to be displayed.      */
 842           /*                                                                                                */
 843           /*  This scheme permits display_block to use caller-declarations for Dinfo_item, iFile, and iBlok */
 844           /*  structures.  Values for three variables above are NOT changed by display_block.               */
 845           /*                                                                                                */
 846           /*  USURPS caller-supplied variables:                                                             */
 847           /*   iBlokP         points to iBlok structure for block to be displayed.  Set by caller, this     */
 848           /*                  is changed only if user response selects a different block to display in      */
 849           /*                  same info segment; iBlokP then points to iBlok of new block to display before */
 850           /*                  branching to hi.ANOTHER_BLOCK_LABEL. (e.g., find_ep or find responses)        */
 851           /*   iSectP         points to iSect structure for current section.                                */
 852           /*   iPgh           points to iPgh  structure for a paragraph of interest.                        */
 853           /*   iLineP         points to iLine structure for a line of interest.                             */
 854           /*                                                                                                */
 855           /*  Shared REFERENCE and USURPing of variables permits the complex structures based on these      */
 856           /*  variables to be declared only once in their respective include files, rather than having to   */
 857           /*  be declared again in many support subroutines and response routines.                          */
 858           /*                                                                                                */
 859           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 860 
 861 display_block:
 862      proc ();
 863 
 864      if  iFileP = null()  then do;                          /* Assert: caller's iFileP should not be null().          */
 865           call error (hi.sciP, error_table_$noentry, " iFileP null in: ^a^[>^]^a^[$^a^;^s^]^[ info: ^a^;^s^]",
 866                Dinfo_item.dir, (Dinfo_item.dir ^= ">"), Dinfo_item.ent,
 867                (Dinfo_item.ep ^= ""), Dinfo_item.ep,
 868                (Dinfo_item.info_name ^= ""), Dinfo_item.info_name);
 869           return;
 870           end;
 871 
 872      if  iBlokP = null()  then do;                          /* Assert: caller's iBlokP should not be null().          */
 873           call error (hi.sciP, error_table_$noentry, " iBlokP null in: ^a^[>^]^a^[$^a^;^s^]^[ info: ^a^;^s^]",
 874                Dinfo_item.dir, (Dinfo_item.dir ^= ">"), Dinfo_item.ent,
 875                (Dinfo_item.ep ^= ""), Dinfo_item.ep,
 876                (Dinfo_item.info_name ^= ""), Dinfo_item.info_name);
 877           return;
 878           end;
 879 
 880 /* ----------------------------------------------------------------------
 881     Setup appropriate ssu_ request table.
 882    ---------------------------------------------------------------------- */
 883 
 884   dcl  TABLE_POSITION_1 fixed bin int static options(constant) init(1);
 885 
 886      hi.info_numbers = 0;                                   /* Reset progress, display mode/limit, line counts        */
 887      hi.info_switches = F;
 888 
 889      if  info_seg_util_$is_Subroutine_kind (iBlok.kind)  then do;
 890           hi.display_mode = DISPLAY_MODE_subroutine;        /* Subroutine block                                       */
 891           call ssu_$add_request_table (hi.sciP, addr(help_request_tables_$for_subroutine_info),
 892                TABLE_POSITION_1, code);
 893           end;
 894      else do;                                               /* Non-subroutine block                                   */
 895           hi.display_mode = DISPLAY_MODE_non_subroutine;
 896           call ssu_$add_request_table (hi.sciP, addr(help_request_tables_$for_non_subroutine_info),
 897                TABLE_POSITION_1, code);
 898           end;
 899      if  code ^= 0  then do;
 900           call error (hi.sciP, code,
 901                "Unexpected error while setting up ssu_ ^[non-subroutine^;subroutine^;help^] request table",
 902                hi.display_mode);
 903           goto hi.SUBSYSTEM_ABORT_LABEL;
 904           end;
 905 
 906 
 907 
 908 /* --------------------------------------------------------------------------------
 909     Step 0:  Before calling ssu_$listen, assure that...
 910 
 911      hi.storage          = null   =>  all storage associated with display of
 912                                       prior block now released from the temp seg.
 913 
 914      hi.selected.iPghP   = null  \
 915                                   =>  "Current paragraph" is at "top" of block
 916      hi.selected.iSectP  = null  /
 917 
 918 
 919      hi.iPgh_print_range = null   =>  No "paragraph print range" has been set.
 920    -------------------------------------------------------------------------------- */
 921 
 922      hi.info_ptrs = null();                                 /* Holds hi.storage, hi.selected, hi.iPgh_print_range     */
 923 
 924      hi.iFileP = iFileP;                                    /* Save caller-supplied pointers to info_seg_ structures  */
 925      hi.iBlokP = iBlokP;                                    /*  for this block.                                       */
 926 
 927      hi.block_progress = BLOCK_PROGRESS_new_block;          /* Begin processing a new info block.                     */
 928 
 929      hi.info_switches.Sctl = help_args.Sctl;                /*  - Copy caller's control args to help_ storage for     */
 930                                                             /*    this info seg.                                      */
 931 %page;
 932 /* --------------------------------------------------------------------------------
 933    Check block against help -section and help -search constraints.
 934     - If block contains no matching section titles and/or paragraphs, it is skipped.
 935       But... if another version of file was found in a different search directory,
 936       that version is examined instead (in the next call to display_block).
 937    -------------------------------------------------------------------------------- */
 938 
 939      hi.block_progress = BLOCK_PROGRESS_section_search;     /* Apply -section/-search control args to this block.     */
 940 
 941   dcl  J fixed bin;
 942 
 943      if  hi.display_mode = DISPLAY_MODE_subroutine          /* For subroutine info_seg having several blocks...       */
 944       &  iFile.relatives.bloks.firstP ^= iFile.relatives.bloks.lastP
 945       &  iBlokP = iFile.relatives.bloks.firstP  then do;    /*  where no $entrypointname was given in pathname...     */
 946           if  hi.Sctl.scn | hi.Sctl.srh  then do;           /*  then search for a matching :Entry: block.             */
 947                call help_util_$execute (hi.sciP, help_infoP, "find_ep");
 948                if  hi.prompt_repeatS  then                  /*  - If argument error was reported, do nothing further. */
 949                     goto hi.SUBSYSTEM_ABORT_LABEL;
 950                if  ^hi.section_search_matchedS  then        /*  - If no block matches -scn/-srh, ignore subr info seg */
 951                     goto EP_SEARCH_FAILED;
 952                end;
 953           end;
 954 
 955      if  hi.Sctl.scn  then do;                              /* Look for particular section title in info block.       */
 956           call help_util_$execute (hi.sciP, help_infoP, "section");
 957           if  hi.prompt_repeatS  then                       /*  - If argument error was reported, do nothing further. */
 958                goto hi.SUBSYSTEM_ABORT_LABEL;
 959           if  hi.section_search_matchedS  then do;          /*  - If found, limit display to matching section.        */
 960                hi.display_limit = DISPLAY_LIMIT_section;
 961                goto DISPLAY_matched;
 962                end;
 963           end;
 964 
 965      if  hi.Sctl.srh  then do;                              /* Search for particular strings in info block.           */
 966           call help_util_$execute (hi.sciP, help_infoP, "search");
 967           if  hi.prompt_repeatS  then                       /*  - If argument error was reported, do nothing further. */
 968                goto hi.SUBSYSTEM_ABORT_LABEL;
 969           if  hi.section_search_matchedS  then do;          /*  - If found, limit display to matching pgh plus any    */
 970                hi.display_limit = DISPLAY_LIMIT_section;    /*    other paragraphs following it in that section.      */
 971                goto DISPLAY_matched;
 972                end;
 973           end;
 974 
 975 
 976      if  hi.Sctl.scn | hi.Sctl.srh  then do;                /* All searching failed...                                */
 977 EP_SEARCH_FAILED:                                           /*  - Ignore this info block silently...                  */
 978           J = hi.Dinfo_sort_ptrsI;                          /*    but if next block has same name, consider it to be  */
 979                                                             /*    a non-duplicate.  Next call to display_block will   */
 980           if  J < PDinfo_seg.N  then                        /*    search within it for possible match.                */
 981           if  PDinfo_seg.P (J+1) -> Dinfo_item.Scross_ref  then
 982                PDinfo_seg.P (J+1) -> Dinfo_item.Scross_ref = F;
 983           return;
 984           end;
 985 
 986 /* --------------------------------------------------------------------------------
 987     Step 0a:  Before calling ssu_$listen:
 988 
 989      - If -section succeeded: "Current paragraph" is at "top" of section with
 990                               matching section title.
 991             hi.selected.iSectP    points to matching section (i.e., to that section's iSect structure)
 992             hi.selected.iPghP     = null
 993 
 994             hi.iPgh_print_range   = null (i.e., No "print range" has been set.)
 995 
 996      - If -search succeeded:  "Current paragraph" selects paragraph matched by
 997                               the -search STR.  This could be in same section matched
 998                               by any -section STR (if one was given), or in paragraph
 999                               of a subsequent section.
1000             hi.selected.iPghP     points to matching paragraph (i.e., to that paragraph's iPgh structure)
1001             hi.selected.iSectP    points to section containing matching paragraph
1002 
1003             hi.iPgh_print_range   = null (i.e., No "paragraph print range" has been set.)
1004    -------------------------------------------------------------------------------- */
1005 %page;
1006 /* --------------------------------------------------------------------------------
1007    Block has passed all constraints.
1008     - Process help control args that display specific info from the block without
1009       prompting.  These include:
1010          -header  -brief  -control_arg  -titles  -lep  -all
1011    -------------------------------------------------------------------------------- */
1012 
1013 DISPLAY_matched:
1014      hi.block_progress = BLOCK_PROGRESS_needs_header;       /* Block header not displayed as yet.  Do it only once    */
1015                                                             /*  in the code that follows.  When invoked, the "header" */
1016                                                             /*  response sets progress to: BLOCK_PROGRESS_display     */
1017 
1018      hi.infos_printedN = hi.infos_printedN + 1;             /* Count info as having been printed.                     */
1019 
1020      if  hi.Sctl.he_only                                    /* Implement -header help control arg...                  */
1021       |  Dinfo_item.Scross_ref  then do;                    /*   - If only printing a header, do that now and return. */
1022                                                             /*     Same also if only reporting another version of     */
1023                                                             /*     info seg was found in a later search directory.    */
1024           call help_util_$execute (hi.sciP, help_infoP, "header");
1025           return;
1026           end;
1027 
1028 
1029      if  hi.display_mode = DISPLAY_MODE_subroutine  then    /* For subroutines, prepare to invoke list_entry_points   */
1030                                                             /*  request.  Side-effect is to replace placeholder       */
1031                                                             /*  "Entry points in SUBR_REFNAME_:" section with a       */
1032                                                             /*  help_-generated list of entry points fabricated by    */
1033                                                             /*  this call.                                            */
1034           call help_responses_$lep_setup (hi.sciP, help_infoP);
1035 
1036 
1037 
1038 ALL_PARAGRAPHS:                                             /* The "all_paragraphs" request branches to this label,   */
1039                                                             /*  with hi.Sctl.XXX = F, and  hi.Sctl.all = T  AND...    */
1040                                                             /*   for non_subroutine: hi.iBlokP at current block       */
1041                                                             /*   for subroutine:     hi.iBlokP at subr intro block    */
1042 
1043      if  hi.Sctl.all  then do;                              /* Implement first parts of -all:                         */
1044           hi.selected = null();                             /*  - Position to "top" of info block (in case -search    */
1045           hi.iPgh_print_range = null();                     /*    or -section repositioned in code above).            */
1046           call help_util_$execute (hi.sciP, help_infoP, "header");
1047           end;                                              /*  - Display a header documenting lines in the block.    */
1048                                                             /*  - Continue processing...                              */
1049                                                             /*    Show any -bf/-ca/-titles output before block lines. */
1050 
1051      if  hi.Sctl.bf  then                                   /* Implement -brief: show brief summary of info block.    */
1052                                                             /*  (If -brief given w/o -all, "brief" request will call  */
1053                                                             /*   the "header" request if needed.)                     */
1054           call help_util_$execute (hi.sciP, help_infoP, "brief");
1055 
1056      if  hi.Sctl.ca  then                                   /* Implement -control_arg: show data about particular     */
1057                                                             /*    args or control args.                               */
1058                                                             /*  (If -ca given w/o -all, "control_arg" request calls   */
1059                                                             /*   the "header" request if needed.)                     */
1060           call help_util_$execute (hi.sciP, help_infoP, "control_arg");
1061 
1062      if  hi.Sctl.title  then                                /* Implement -titles: show section title name/count       */
1063                                                             /*  (If -titles given w/o -all, "titles" request calls    */
1064                                                             /*   the "header" request if needed.)                     */
1065           call help_util_$execute (hi.sciP, help_infoP, "titles -top");
1066 
1067 
1068      if  hi.Sctl.lep  &  hi.display_mode = DISPLAY_MODE_subroutine  then do;
1069                                                             /* Implement -lep: show headers for all entrypoints       */
1070           call help_util_$execute (hi.sciP, help_infoP, "list_entry_points");
1071 
1072                                                             /*  - Normalize hi.selected to get an iSectP.             */
1073           if  hi.iSectP = null()  &  hi.iPghP = null()  then
1074                iSectP = iBlok.relatives.sects.firstP;       /*     - If "top", select first section of block.         */
1075           else if  hi.iSectP = null  &  hi.iPghP ^= null()  then do;
1076                iPghP = hi.iPghP;                            /*     - If -search found paragraph, select that section  */
1077                iSectP = iPgh.relatives.sectP;
1078                end;                                         /*     - Otherwise, don't change "current section"        */
1079 
1080           if  iSect.type = iSect_ENTRY_POINTS_IN  then do;  /*  - We've just displayed "Entry points in ..." list.    */
1081                                                             /*    If "current paragraph" resides in that section,     */
1082                                                             /*     move it to the next section or first ep block.     */
1083                if  iSect.sib.nextP ^= null()  then do;
1084                     hi.iSectP = iSect.sib.nextP;            /*     - Move to section beyond "Entry points in..."      */
1085                     hi.iPghP  = null();
1086                     end;
1087                else if  iBlok.sib.nextP ^= null  then do;
1088                     hi.iBlokP, iBlokP = iBlok.sib.nextP;    /*     - Move to first subroutine :Entry: block.          */
1089                     hi.selected = null();
1090                     hi.another_blockS = T;
1091                     end;
1092                end;
1093           end;
1094 
1095      if  hi.Sctl.all  then
1096 DISPLAY_ALL:
1097      do;                                                    /* Remainder of -all:                                     */
1098           iBlokP = hi.iBlokP;                               /*  - Reset iBlokP to current block being displayed.      */
1099                                                             /*    This could differ from code above when the          */
1100                                                             /*    all_paragraphs request transfers to the             */
1101                                                             /*    ALL_PARAGRAPHS label above.                         */
1102 
1103           call newline(1);                                  /*  - Separate header from 1st section of info block.     */
1104 
1105           do iSectP = iBlok.sects.firstP                    /*  - Show info block sections.                           */
1106                repeat iSect.sib.nextP while (iSectP ^= null() );
1107                call help_util_$print_section (hi.sciP, help_infoP, iSectP);
1108                end;
1109 
1110           call newline (1);                                 /*  - Separate final block section from any content of    */
1111                                                             /*    of subsequent info blocks.                          */
1112 
1113           if  iBlok.kind = iBlok_kind_SUBROUTINE_INTRO      /* For subroutine intro, -all prints all entrypoints.     */
1114            |  iBlok.kind = iBlok_kind_SUBROUTINE_BRIEF_INTRO  then do;
1115                do iBlokP = iBlok.sib.nextP
1116                     repeat iBlok.sib.nextP  while (iBlokP ^= null() );
1117                     if  iBlok.kind = iBlok_kind_SUBROUTINE_ENTRY  then do;
1118                          call newline (help_args.Lspace_between_infos);
1119 
1120                          hi.iBlokP = iBlokP;
1121                          hi.another_blockS = T;
1122                          call help_util_$execute (hi.sciP, help_infoP, "header");
1123 
1124                          do iSectP = iBlok.sects.firstP     /*  - Show info block sections.                           */
1125                               repeat iSect.sib.nextP while (iSectP ^= null() );
1126                               call help_util_$print_section (hi.sciP, help_infoP, iSectP);
1127                               end;
1128                          end;
1129                     end;
1130                end;
1131           end DISPLAY_ALL;
1132 
1133      if  hi.Sctl.bf  |  hi.Sctl.ca  |  hi.Sctl.all  then    /* If -brief, -ca or -all help control args given, we've  */
1134           return;                                           /*   done those steps.  Return now.                       */
1135 
1136 %page;
1137 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
1138 /*                                                                                                                    *
1139    The ssu_$listen LISTENER LOOP supervises printing of help paragraphs, display of "More help?" prompts, and
1140    processing of user's response to each prompt (the response is an ssu_ request line).  The LOOP consists of
1141    four-steps:
1142 
1143                When entering step 1:
1144                 If hi.selected.iPghP  ^= null,     it points to the actual "last paragraph printed" iPgh structure.
1145 
1146                 But if switching to a new section or paragraph...
1147                          If hi.iPghP   = null  &
1148                             hi.iSectP  = null:     "last paragraph printed" appears to point to a paragraph
1149                                                    before 1st section of block.
1150                          If hi.iPghP   = null  &
1151                             hi.iSectP ^= null:     "last paragraph printed" appears to point to the paragraph
1152                                                    before that section.
1153 
1154     Step 1:  Uses "last paragraph printed", hi.display_limit, and count of unseen paragraphs to determine
1155              what paragraphs to display next; then tells user what they are...  via a "More help?" prompt.
1156              ssu_$listen calls help_listen_util_$display_prompt to perform step 1.
1157 
1158 
1159 
1160                When entering step 2 and for all subsequent steps:
1161                    hi.iPgh_print_range.startP   points to first iPgh to print.
1162                                       .endP     points to last iPgh to print.
1163 
1164 
1165                    hi.selected.iPghP   = hi.iPgh_print_range.startP ("current paragraph" is first paragraph to be displayed)
1166                               .iSectP  = pointer to iSect describing section containing "current paragraph"
1167 
1168                    hi.prompt_repeatS   = T:  Nothing is printed by step 4; step 1 recomputes and displays "More help?" prompt.
1169 
1170     Step 2:  ssu_$listen reads and processes the user's response to that "More help?" prompt.
1171               - It break's response line into one or more ssu_ requests.
1172               - Invokes each request (which is usually a help_ response routine).
1173               - If user types an empty response line,  hi.prompt_repeatS = T  causes prior prompt to be redisplayed.
1174 
1175     Step 3:  Each help_responses_ routine can adjust hi.selected and hi.iPgh_print_range,
1176              or make no adjustments: these values select which paragraphs are to be displayed.
1177 
1178              A response routine may also change:
1179                hi.display_limit:  can have one of the following four values.
1180                                     DISPLAY_LIMIT_none         => display all paragraphs that fit on the video page.
1181                                     DISPLAY_LIMIT_section      => display only paragraphs of current section.
1182                                     DISPLAY_LIMIT_unseen       => display only unseen paragraphs.
1183                                     DISPLAY_LIMIT_rest_unseen  => display all remaining unseen paragraphs.
1184              To display any paragraphs in step 4, a response routine must set:
1185                hi.prompt_repeatS = F    => either the incoming hi.iPgh_print_range is displayed,
1186                                                or an adjusted hi.selected and/or hi.iPgh_print_range displayed.
1187 
1188 
1189                When entering step 4:
1190                 If hi.iPgh_print_range  ^= null:  hi.iPgh_print_range.startP and .endP delimit the exact set of
1191                                                    paragraphs to display.
1192                                          = null:  if both .startP is null, then...
1193                                                    hi.selected values specify a new "current paragraph".
1194                                                    In that case, help_listen_util_$set_iPgh_range is called to map
1195                                                    that "current paragraph" into a new pair of hi.iPgh_print_range
1196                                                    .startP and .endP pointers.
1197                                                      If hi.display_limit = DISPLAY_LIMIT_section, that print range is
1198                                                      to paragraphs of the "current paragraph"s section,
1199                                                      limited from that current paragraph onward.
1200 
1201     Step 4:  If hi.prompt_repeatS ^= T, then display paragraphs of the hi.iPgh_print_range
1202               - If hi.display_limit >= DISPLAY_LIMIT_unseen, then only unseen paragraphs in print range are displayed.
1203 
1204              ssu_$listen calls help_listen_util_$print_iPgh_range to perform step 4.  After performing its work,
1205              it returns back to ssu_$listen... which iterates again through LOOP.... starting at step 1.
1206 
1207 
1208    The code below enters the ssu_ LISTENER LOOP described above by:
1209     - performing the part of step 1 that determines WHICH PARAGRAPHS TO PRINT first (w/o displaying a prompt);
1210     - displaying a HEADER describing the info block, how many lines it contains, and how many lines will be printed first.
1211     - then calling the step 4 routine directly to PRINT those first PARAGRAPHS OF THE INFO BLOCK; and finally
1212     - calling ssu_$listen to start the LOOP at step 1.
1213 
1214 /*                                                                                                                    *
1215 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
1216 %page;
1217 /* -----------------------------------------------------------------
1218    Print header for info block, and first few paragraphs.
1219    Then enter the ssu_ listener which supervises the
1220    help_ prompt/response loop.
1221    ----------------------------------------------------------------- */
1222 
1223 BLOCK_DISPLAY_BEGINS:                                       /* Begin display of selected info seg block.              */
1224      hi.ANOTHER_BLOCK_LABEL = ANOTHER_BLOCK_OF_SAME_INFO_SEG;
1225                                                             /*  - find_info, find_ep or ep response branches back here*/
1226                                                             /*    when user asks for different block of info seg.     */
1227      hi.ALL_PARAGRAPHS_LABEL = ALL_PARAGRAPHS;              /*  - all_paragraphs or all_entrypoints branches back     */
1228                                                             /*    here to display "all" of current block/subroutine   */
1229 
1230      iBlokP = hi.iBlokP;                                    /*  - Make sure iBlokP points to possibly just-switched   */
1231                                                             /*    block.  Block selection can occur:                  */
1232                                                             /*     above: for help SUBR_ -search STRING               */
1233                                                             /*     below: at ANOTHER_BLOCK_OF_SAME_INFO_SEG label     */
1234                                                             /*            after: "find_ep", "find_info", "ep", or     */
1235                                                             /*                   "info" responses, or END_OF_INFO     */
1236                                                             /*                   when walking thru unseen SUBR blocks */
1237                                                             /*    Since iBlokP isn't referenecd in code below, this   */
1238                                                             /*    is useful primarily when debugging help_.           */
1239 
1240      if  hi.infos_printedN > 1  then                        /*  - Two blank lines separate one info block from next   */
1241           call newline (2);
1242 
1243      if  hi.display_limit > DISPLAY_LIMIT_section  then     /*  - Turn off unseen and rest_unseen display limits      */
1244           hi.display_limit = DISPLAY_LIMIT_none;            /*    each time a new block is processed.                 */
1245 
1246      if  hi.block_progress = BLOCK_PROGRESS_needs_header | hi.another_blockS then do;
1247                                                             /*  - Need some kind of header displayed for this block.  */
1248           call help_listen_util_$set_iPgh_range (hi.sciP);  /*     - Set initial paragraph print range.               */
1249                                                             /*       This sets hi.header_Nlines_follow for that range.*/
1250           call help_util_$execute  (hi.sciP, help_infoP, "header");
1251                                                             /*     - Then display a header for the block.             */
1252           end;
1253 
1254      if  ^hi.prompt_repeatS  then                           /*  - Print the first range of paragraphs.                */
1255           call help_listen_util_$print_iPgh_range (hi.sciP);
1256 
1257      call ssu_$listen (hi.sciP, iox_$user_input, code);     /*  - Let ssu_ listener supervise printing rest of block. */
1258      if  code = ssu_et_$subsystem_aborted  then
1259           goto SUBSYSTEM_ABORTED;
1260      else if  code ^= 0  then
1261           call error (hi.sciP, code, "calling ssu_$listen as help_ prompt/response routine.");
1262      return;                                                /*  - End of displaying this block.                       */
1263                                                             /*     - Return to help_ caller of display_block().       */
1264 
1265 /* -----------------------------------------------------------------
1266    Branch here with hi.iBlokP set to block to be displayed, and
1267    hi.selected = null() (start at "top" of block).  Used by:
1268     - entry_point (ep), info, and find_ep (find) responses;
1269     - help_listen_util_$display_prompt goes here if displaying
1270       a subroutine intro block, to continue with
1271       first entrypoint description for that subroutine.
1272    ----------------------------------------------------------------- */
1273 
1274 ANOTHER_BLOCK_OF_SAME_INFO_SEG:                             /* When transferring in from find_XXX response...         */
1275      call newline (help_args.Lspace_between_infos);         /*  - Separate prior block's data from data in new block. */
1276      hi.info_switches.another_blockS = T;                   /*  - Display a block-change HEADING line for new block.  */
1277      hi.clear_prompt_regionS = F;                           /*  - Do not clear prompts at point of switching blocks.  */
1278      goto BLOCK_DISPLAY_BEGINS;
1279 
1280      end display_block;
1281 
1282 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
1283 %page;
1284 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1285 
1286 evaluate_path:
1287      procedure (info_path, suffix);
1288 
1289   dcl 1 info_path aligned like help_args.path,
1290        suffix char (*);
1291 
1292   dcl  i fixed bin;
1293 
1294   dcl  check_star_name_$entry entry (char (*), fixed bin (35)),
1295        expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
1296 
1297      info_path.dir (1) = "";                                /* Initialize to unset so caller can depend on these      */
1298      info_path.ent = "";                                    /*  values.                                               */
1299      info_path.ep = "";
1300 
1301      info_path.S.less_greater = (search (info_path.value, "<>") > 0);
1302                                                             /* Was some part of dir given?                            */
1303 
1304      i = index (reverse (info_path.value), "$");            /* Was entrypoint name given?                             */
1305      if  info_path.S.less_greater  then                     /*  - Must allow $ in entry names forming dir part of path*/
1306      if  search (reverse (info_path.value), "<>") < i  then
1307           i = 0;
1308      if  i > 0  then                                        /*  - Save entrypoint name from user in his path input    */
1309           info_path.ep = substr (info_path.value, length (info_path.value) - i + 2);
1310      else info_path.ep = "";
1311 
1312 
1313      call expand_pathname_$add_suffix (substr (info_path.value, 1, length (info_path.value) - i), suffix,
1314           info_path.dir (1), info_path.ent, info_path.code);
1315      if  info_path.code ^= 0  then                          /* separate pathname into dir/ent parts, add info suffix  */
1316           return;
1317 
1318      if  info_path.S.pn_ctl_arg  then                       /* if -pn given, assume relative pathname follows.        */
1319           info_path.S.less_greater = T;                     /*  (Note we've already expanded path on this assumption.)*/
1320 
1321 
1322      if  info_path.info_name = ""  then do;                 /* info_name usually = entryname w/o suffix.              */
1323           info_path.S.separate_info_name = F;
1324           if suffix = "" then
1325                info_path.info_name = info_path.ent;
1326           else info_path.info_name =
1327                substr (info_path.ent, 1, 32 - length (suffix) - index (reverse (info_path.ent), reverse (suffix) || "."));
1328           end;
1329      else info_path.S.separate_info_name = T;
1330 
1331 
1332      call check_star_name_$entry (info_path.ent, info_path.code);
1333 
1334      if  info_path.code = 0  then do;                       /* 0 means no starname given...                           */
1335           info_path.S.starname_ent = F;                     /*   -ep argument allowed when starname not given.        */
1336           if  help_args.Sctl.ep & info_path.ep = ""  then   /*   Default ep name = entryname w/o suffix.              */
1337                if  suffix = ""  then
1338                     info_path.ep = info_path.ent;
1339                else info_path.ep =
1340                     substr (info_path.ent, 1, 32 - length (suffix) - index (reverse (info_path.ent), reverse (suffix) || "."));
1341           end;
1342 
1343      else if  info_path.code = 1  |  info_path.code = 2  then do;
1344           info_path.code = 0;                               /* 1 or 2 means starname was given...                     */
1345           info_path.S.starname_ent = T;
1346           if help_args.Sctl.ep | (info_path.ep ^= "") then  /*   forbid -ep if starname was given.                    */
1347                info_path.code = error_table_$inconsistent;
1348           end;
1349 
1350      if  info_path.code ^= 0  then                          /* Stop evaluation if error detected.                     */
1351           return;
1352 
1353 
1354      if info_path.S.separate_info_name then do;             /* Check star-ness of user-supplied info_name.            */
1355           if  info_path.S.info_name_not_starname  then      /*  - Caller asserts that info_name not starname          */
1356                info_path.S.starname_info_name = F;
1357           else do;
1358                call check_star_name_$entry (info_path.info_name, info_path.code);
1359                if  info_path.code = 1  |  info_path.code = 2  then do;
1360                     info_path.code = 0;                     /*  1 or 2 means info_name is a starname...               */
1361                     info_path.S.starname_info_name = T;
1362                     end;
1363                else info_path.S.starname_info_name = F;
1364                end;
1365           end;
1366      else info_path.S.starname_info_name = info_path.S.starname_ent;
1367 
1368      end evaluate_path;
1369 
1370 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1371 %page;
1372 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1373 
1374 get_info_seg_list:                                          /* Find info blocks matching info_path                    */
1375      procedure (suffix, fcn, dirs, info_path, PDinfo_);
1376 
1377                                                             /*        Input Parameters                                */
1378   dcl  suffix char (*),                                     /* help_$init (or caller) provided suffix for info segs.  */
1379        fcn fixed bin,                                       /*  = HELP: help_ is our caller.                          */
1380                                                             /*  = CIS:  help_$check_info_segs is our caller.          */
1381        dirs (*) char (168) unaligned,                       /* Array of directories in which to look for info segs.   */
1382                                                             /*  - Could be a specific pathname given by user; or      */
1383                                                             /*  - Array of info_seg (or other) search paths given in  */
1384                                                             /*    help_args.search_dirs                               */
1385       1 info_path aligned like help_args.path,              /* Structure holding one user-provided search request.    */
1386        PDinfo_ ptr;                                         /* Points to storage reserved by caller for Dinfo struct. */
1387                                                             /*  - We declare this as Dinfo_ structure below.          */
1388 
1389   dcl  I fixed bin (21),
1390        Nstart fixed bin,
1391        block_date fixed bin (71),
1392        code fixed bin (35),
1393        (i, j, k) fixed bin,
1394        linfo_name char (32),                                /* info name without the suffix.                          */
1395        sinfo_name char (32),                                /* info name with the suffix.                             */
1396        saved_date fixed bin (71),
1397        some_block_foundS bit (1) aligned,
1398        uid bit (36) aligned;
1399 
1400   dcl 1 Dinfo_ aligned based (PDinfo_),                     /* Our view of caller's Dinfo structure.                  */
1401       2 N fixed bin,
1402       2 item (0 refer (Dinfo_.N)),
1403         3 seg like Dinfo_seg;
1404 
1405   dcl  hcs_$star_dir_list_ entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)),
1406        hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
1407 %page;
1408      Nstart = Dinfo_.N;                                     /* Remember count of info segs found earlier,             */
1409                                                             /*   to see if we find matches for current path.          */
1410 
1411      star_list_names_ptr, star_list_branch_ptr = null ();
1412      on cleanup call free_dir_list ();                      /* Prep to free storage by hcs_$star_dir_list_            */
1413 
1414 ENTRIES_IN_DIRS:
1415      do i = lbound (dirs, 1) to hbound (dirs, 1);           /* Search for info path in each directory to be searched. */
1416                                                             /*  May be looking in info_segs search paths.             */
1417           star_select_sw = star_ALL_ENTRIES;
1418           call hcs_$star_dir_list_ (dirs (i), info_path.ent, star_select_sw, addr (hi_area), star_branch_count, star_link_count,
1419                star_list_branch_ptr, star_list_names_ptr, code);
1420 
1421           if code = 0 then
1422 STARNAME_PROCESSING:
1423           do;
1424 WALK_HCS_STAR_ARRAY:
1425                do j = 1 to star_branch_count + star_link_count;
1426                                                             /* Process segs/links found in this directory.            */
1427                     k, Dinfo_.N = Dinfo_.N + 1;
1428                     Dinfo_.seg (k).Scross_ref = F;
1429                     Dinfo_.seg (k).dir = dirs (i);
1430                     Dinfo_.seg (k).ent = star_list_names (star_dir_list_branch (j).nindex);
1431                     Dinfo_.seg (k).info_name = "";
1432                     Dinfo_.seg (k).ep, Dinfo_.seg (k).E = info_path.ep;
1433                     Dinfo_.seg (k).segment_type = star_dir_list_branch (j).type;
1434 
1435                                                             /* Process by entry type...                               */
1436                     if  star_dir_list_branch (j).type = star_SEGMENT  then do;
1437                                                             /*  - For an info segment...                              */
1438                          Dinfo_.seg (k).L = divide (star_dir_list_branch (j).bit_count, BITS_PER_CHAR, 24, 0);
1439                          Dinfo_.seg (k).date = numeric_date (star_dir_list_branch (j).dtem);
1440                          Dinfo_.seg (k).mode = substr (star_dir_list_branch (j).mode, 2, 3);
1441                                                             /*     - extract access "rew" mode bits from "trewa".     */
1442                          Dinfo_.seg (k).code = 0;           /*     - no errors encountered as yet for this info seg   */
1443 
1444                          if Dinfo_.seg (k).L = 0 then       /*        - Oops, info seg empty?                         */
1445                               Dinfo_.seg (k).code = error_table_$zero_length_seg;
1446 
1447                          else if (star_dir_list_branch (j).bit_count - (BITS_PER_CHAR * Dinfo_.seg (k).L)) > 0 then
1448                                                             /*        - bits after last whole character?              */
1449                                                             /*           [equiv to: mod(Bit_count, BIT_PER_CHAR) > 0] */
1450                               Dinfo_.seg (k).code = error_table_$bad_seg;
1451                          end;
1452 
1453                     else if  star_dir_list_branch (j).type = star_LINK  then
1454 CHASE_LINK:         do;                                     /*  - For link: chase link looking for target info seg    */
1455                          call hcs_$status_long (Dinfo_.seg (k).dir, Dinfo_.seg (k).ent, 1,
1456                               addr (branch), null (), code);
1457 
1458                          if  (code = 0)  |  (code = error_table_$no_s_permission)  then do;
1459                               if branch.type = Segment then do;
1460                                                             /*     - Get info equivalent to above directly from branch*/
1461                                                             /*       NOTE: we may not have "s" access to target dir   */
1462                                    Dinfo_.seg (k).L = divide (binary (branch.bit_count, 24), BITS_PER_CHAR, 24, 0);
1463                                    Dinfo_.seg (k).date = numeric_date (branch.dtem);
1464                                    Dinfo_.seg (k).mode = substr (branch.mode, 2, 3);
1465                                    Dinfo_.seg (k).code = 0;
1466                                    if Dinfo_.seg (k).L = 0 then
1467                                         Dinfo_.seg (k).code = error_table_$zero_length_seg;
1468                                    else if (binary (branch.bit_count, 24) - (BITS_PER_CHAR * Dinfo_.seg (k).L)) > 0 then
1469                                         Dinfo_.seg (k).code = error_table_$bad_seg;
1470                                    end;
1471 
1472                               else if  branch.type = Link  then do;
1473                                                             /*  - circular link or link chain too long                */
1474                                    Dinfo_.seg (k).L = 0;
1475                                    Dinfo_.seg (k).date = 0;
1476                                    Dinfo_.seg (k).mode = "0"b;
1477                                    Dinfo_.seg (k).code = error_table_$noentry;
1478                                    end;
1479 
1480                               else do;                      /*  - Silently skip matching directories.                 */
1481                                    Dinfo_.N = Dinfo_.N - 1;
1482                                                             /*    Forget everything we've done for this entry */
1483                                    go to SKIP_ENTRY;
1484                                    end;
1485                               end;
1486 
1487                          else do;                           /*  - Error: no access to the link target.                */
1488                               Dinfo_.seg (k).L = 0;
1489                               Dinfo_.seg (k).date = 0;
1490                               Dinfo_.seg (k).mode = "0"b;
1491                               Dinfo_.seg (k).code = code;
1492                               end;
1493                          end CHASE_LINK;
1494 
1495                     else do;                                /*  - Silently skip matching directories.                 */
1496                          Dinfo_.N = Dinfo_.N - 1;
1497                          go to SKIP_ENTRY;
1498                          end;
1499 
1500                     if  Dinfo_.seg (k).code = 0  then do;   /*  - If no errors found while searching...               */
1501 
1502                          if (Dinfo_.seg (k).mode & R_ACCESS) then
1503                                                             /*    - If can read info seg...                           */
1504                               if help_args.min_date_time ^< Dinfo_.seg (k).date then
1505                                    Dinfo_.N = Dinfo_.N - 1; /*       - Skip seg if older than help_args.min_date_time */
1506                               else ;                        /*    - Else continue with this seg.                      */
1507                          else Dinfo_.seg (k).code = error_table_$moderr;
1508                          end;                               /*  - Error: user has no read access to info seg.         */
1509 
1510 SKIP_ENTRY:         end WALK_HCS_STAR_ARRAY;
1511 
1512                call free_dir_list ();
1513                end STARNAME_PROCESSING;
1514 %page;
1515           else if  (code = error_table_$incorrect_access | code = error_table_$no_info) & ^info_path.S.starname_ent  then
1516 NON_STARNAME_PROCESSING:
1517           do;                                               /* If user does not have "s" permission to dir,           */
1518                                                             /*  - look for a specific help seg.                       */
1519                call hcs_$status_long (dirs (i), info_path.ent, 1, addr (branch), null (), code);
1520 
1521                if  (code = error_table_$no_s_permission) | (code = 0)  then do;
1522                     if  branch.type ^= Directory  then do;
1523                          k, Dinfo_.N = Dinfo_.N + 1;
1524                          Dinfo_.seg (k).Scross_ref = F;
1525                          Dinfo_.seg (k).dir = dirs (i);
1526                          Dinfo_.seg (k).ent = info_path.ent;
1527                          Dinfo_.seg (k).info_name = "";
1528                          Dinfo_.seg (k).ep = info_path.ep;
1529                          Dinfo_.seg (k).E = info_path.ep;
1530                          Dinfo_.seg (k).segment_type = branch.type;
1531 
1532                          if  branch.type = Segment  then do;
1533                               Dinfo_.seg (k).L = divide (binary (branch.bit_count, 24), BITS_PER_CHAR, 24, 0);
1534                               Dinfo_.seg (k).date = numeric_date (branch.dtem);
1535                               Dinfo_.seg (k).mode = substr (branch.mode, 2, 3);
1536                               if  Dinfo_.seg (k).mode & R_ACCESS  then
1537                                    Dinfo_.seg (k).code = 0;
1538                               else Dinfo_.seg (k).code = error_table_$moderr;
1539 
1540                               if  Dinfo_.seg (k).L = 0  then
1541                                    Dinfo_.seg (k).code = error_table_$zero_length_seg;
1542                               else if  binary (branch.bit_count, 24) - BITS_PER_CHAR * Dinfo_.seg (k).L > 0  then
1543                                    Dinfo_.seg (k).code = error_table_$bad_seg;
1544                               else if  code = 0  then
1545                                    if  help_args.min_date_time ^< Dinfo_.seg (k).date  then
1546                                         Dinfo_.N = Dinfo_.N - 1;
1547                               end;
1548                          else do;                           /* Give error for link target being a link.               */
1549                               Dinfo_.seg (k).L = 0;
1550                               Dinfo_.seg (k).date = 0;
1551                               Dinfo_.seg (k).mode = "0"b;
1552                               Dinfo_.seg (k).code = error_table_$noentry;
1553                               end;
1554                          end;
1555                     end;
1556                else if  code = error_table_$noentry  then;
1557                else go to DIR_ERROR;
1558 
1559                end NON_STARNAME_PROCESSING;
1560 
1561           else if  code = error_table_$nomatch  then;
1562 
1563           else do;                                          /* hcs_$star_dir_list fatal error looking in this dir.    */
1564 DIR_ERROR:     call error (hi.sciP, code, " Looking for info segments in ^a.", dirs (i));
1565                if dim (dirs, 1) = 1 then
1566                     return;                                 /* Avoid getting nomatch error in addition to             */
1567                end;                                         /* this one when only 1 dir to look into.                 */
1568 
1569           end ENTRIES_IN_DIRS;
1570 %page;
1571      do i = Nstart + 1 to Dinfo_.N;                         /* Supply uid for all just-found info segs.               */
1572           call hcs_$get_uid_file (Dinfo_.seg (i).dir, Dinfo_.seg (i).ent, uid, code);
1573           if  code ^= 0  &  Dinfo_.seg (i).code = 0  then
1574                Dinfo_.seg (i).code = code;
1575           else if  code = 0  then
1576                Dinfo_.seg (i).uid = uid;
1577           end;
1578 
1579      if  fcn = CIS  then do;                                /* For help_$check_info_segs...                           */
1580           do i = Nstart + 1 to Dinfo_.N;                    /*  - in Dinfo_.seg entries just added...                 */
1581                if  Dinfo_.seg (i).code ^= 0  then do;       /*    if found an error in any of these...                */
1582                     Dinfo_.seg (i).uid = "0"b;
1583                     Dinfo_.seg (i).I = 0;                   /*     - zero fields so caller cannot try to              */
1584                     Dinfo_.seg (i).E = "";                  /*       further process this problem entry.              */
1585                     end;
1586                end;
1587           return;                                           /*  - don't try to look inside info seg for blocks        */
1588           end;
1589 
1590 
1591      if  Dinfo_.N = Nstart  then do;                        /* For help_, if no entries found for this path           */
1592                                                             /*  - print error message on behalf of caller             */
1593          if  info_path.S.starname_ent  then
1594               code = error_table_$nomatch;
1595          else code = error_table_$noentry;
1596          call error (hi.sciP, code, " ^[-pn ^]^a", info_path.S.pn_ctl_arg, info_path.value);
1597          return;
1598          end;
1599 %page;
1600 EXAMINE_INFO_SEG:                                           /* For help_, w/ no errors encountered for path...        */
1601                                                             /*  - Look in just-added info segs for :Info:             */
1602      do i = Nstart + 1 to Dinfo_.N;                         /*    and :[Info]: info block dividers.                   */
1603 
1604                                                             /* NOTE: Dinfo_.N is incremented below, but new items     */
1605                                                             /*  are NOT processed by this do group.  do-statement     */
1606                                                             /*  evaluates Dinfo_.N when first entering the do-group.  */
1607                                                             /*  Subsequent increments to Dinfo_.N add items that are  */
1608                                                             /*  beyond the original Dinfo_.N limit of this do-group.  */
1609 
1610           if  info_seg_util_$count_files (addr (isd)) > 10  then
1611 REINITIALIZE:  call info_seg_$reinitialize (addr (isd));    /* Avoid having more than 10 info segs initiated.         */
1612 
1613           iFileP =
1614                info_seg_$examine_iFile (addr (isd), Dinfo_.seg (i).dir, Dinfo_.seg (i).ent, Dinfo_.seg (i).uid,
1615                                         Dinfo_.seg (i).code);
1616                                                             /* Get chain of blocks found in this info seg             */
1617 
1618           if  iFileP = null ()  &                           /* No iFile returned but got other iFiles earlier         */
1619               isd.files.firstP ^= null ()  then
1620                go to REINITIALIZE;                          /*  - Release storage for prior files so this             */
1621                                                             /*    new file can be processed.                          */
1622 
1623           if  Dinfo_.seg (i).code ^= 0  then                /* Report any errors in initiating this new file          */
1624                go to BLOCKS_error;                          /*   ASSERT: .code ^= 0  if iFileP = null()               */
1625 
1626           if  help_args.pad2(6) = 3  then                   /* -db 3 given?                                           */
1627                call ioa ("DEBUG 3: iFile.caseI = ^d,  .structure = ^d", iFile.caseI, iFile.structure);
1628 
1629           if  iFile.structure <= iFile_struc_err_UNSET
1630             | iFile.structure >  iFile_structure_INFO  then do;
1631                Dinfo_.seg (i).code = error_table_$improper_data_format;
1632                go to BLOCKS_error;                          /* Info seg has unrecognized/bad block structure          */
1633                end;
1634 
1635           go to INFO_STRUCTURE (iFile.structure);           /* Next steps vary by structure of info segment.          */
1636 
1637 
1638 INFO_STRUCTURE (iFile_structure_INFO_HCOM):                 /* Info Segment with blocks...                            */
1639                                                             /*  - Each block treated as a separate info by help_.     */
1640           iBlokP = iFile.bloks.lastP;
1641           if  iBlokP ^= null ()  then                       /*     - Unthread history comment block from list.        */
1642           if  iBlok.divider = iBlok_divider_hcom | iBlok.divider = iBlok_divider_hcom_obsolete  then
1643                call info_seg_$unthread_iBlok (iBlokP);
1644 
1645 INFO_STRUCTURE (iFile_structure_INFO):                      /* Info Segment with blocks but no History Comment...     */
1646           saved_date = Dinfo_.seg (i).date;                 /*  - save info seg dtcm for any block w/o header date.   */
1647           Dinfo_.seg (i).info_name = info_path.info_name;
1648                                                             /* save info_name which found this info, for use in any   */
1649                                                             /*  subsequent error message.                             */
1650 
1651           some_block_foundS = F;                            /* 1st matching block's data will go into existing        */
1652                                                             /*   Dinfo_.seg(i); but no match found yet.               */
1653 
1654 CHECK_BLOCKS:
1655           do iBlokP = iFile.bloks.firstP                    /* Check block divider names versus input spec            */
1656                repeat iBlok.sib.nextP while (iBlokP ^= null ());
1657                if  iBlok.no_namesS  then                    /*  - skip block with no divider names.                   */
1658                     goto NEXT_BLOCK;
1659 
1660                call convert_date_to_binary_ (iBlok.header.iso_date, block_date, code);
1661                if  code ^= 0  then
1662                     block_date = saved_date;
1663                if  help_args.min_date_time ^< block_date  then
1664                     go to NEXT_BLOCK;                       /*  - skip blocks older than min_date_time                */
1665 
1666 CHECK_BLOCK_NAMES:
1667                do j = lbound (Blok_names, 1) to hbound (Blok_names, 1);
1668                     if  info_path.S.starname_info_name  then do;
1669                          call match_star_name_ ((Blok_names (j)), info_path.info_name, code);
1670                          if code ^= 0 then
1671                               go to NAME_MISMATCH;
1672                          end;
1673                     else if Blok_names (j) ^= info_path.info_name then
1674                          go to NAME_MISMATCH;
1675 
1676                     if  ^info_path.S.separate_info_name  then do;
1677                                                             /* AVOID POTENTIAL BUG:  Lookup of info seg by            */
1678                                                             /* uid could subvert test to see if divider name          */
1679                                                             /* is really a name on the info seg.  Check if            */
1680                                                             /* divider name really exists on info segment.            */
1681                          if  iBlok.divider = iBlok_divider_Info_no_ext_names  then
1682                               go to NAME_MISMATCH;          /*  :[Info]: divider name never on phys. info seg         */
1683 
1684                          if  suffix ^= ""  then             /* Look for this block name as name on phys. info         */
1685                               sinfo_name = Blok_names (j) || "." || suffix;
1686                          else sinfo_name = Blok_names (j);
1687                                                             /* NOTE: If user has no "s" (status) access on containing */
1688                                                             /*  directory, getting list of external names on seg is   */
1689                                                             /*  not allowed hcs_$status_long, etc.  But...            */
1690                                                             /*  hcs_$get_uid_file can look in that dir for a given    */
1691                                                             /*  info_name; if found file, uid is returned even in     */
1692                                                             /*  directory to which user has no s permission.          */
1693                          call hcs_$get_uid_file (Dinfo_.seg (i).dir, sinfo_name, uid, code);
1694                                                             /*  - Is block divider name also external name?           */
1695                                                             /*    We already know the info seg's uid.                 */
1696                          if  uid ^= Dinfo_.seg (i).uid  then
1697                               go to NAME_MISMATCH;          /*      - It is not.                                      */
1698                          end;
1699                     go to BLOCK_MATCHES;
1700 
1701 NAME_MISMATCH:      end CHECK_BLOCK_NAMES;
1702 
1703                go to NEXT_BLOCK;                            /* None of names on this block match input spec           */
1704 
1705 %page;
1706 BLOCK_MATCHES:
1707                if  ^some_block_foundS  then do;             /* k = i: overwrite original Dinfo_(i) element.           */
1708                                                             /*        with data specific to matching block.           */
1709                     k = i;
1710                     some_block_foundS = T;
1711                     end;
1712                else do;                                     /* Already overwrote Dinfo_(i) element, so create a new   */
1713                                                             /*  one to hold data specific to 2nd...Nth matching blocks*/
1714                     k, Dinfo_.N = Dinfo_.N + 1;             /*   - This new entry is NOT examined by later            */
1715                                                             /*     iterations thru EXAMINE_INFO_SEG do-group.         */
1716                                                             /*     See NOTE at that label - above.                    */
1717                     Dinfo_.seg (k) = Dinfo_.seg (i);        /*  - copy data from original Dinfo_.item(i) to           */
1718                     end;                                    /*    new Dinfo_.item(k) structure.                       */
1719 
1720                if ^info_path.S.separate_info_name then
1721                     Dinfo_.seg (k).ent = sinfo_name;        /*  - In case of starname, use this block name as         */
1722                                                             /*    name by which phys. info seg was found.             */
1723                Dinfo_.seg (k).date = block_date;            /*  - Use date in block header line as date modified      */
1724                                                             /*    for this block.                                     */
1725 
1726                Dinfo_.seg (k).I = charno (iBlok.P);         /*  - Save offset of block text w/in info seg so we can   */
1727                                                             /*    later identify (perhaps recreated) iBlok structure  */
1728                                                             /*    for this block.                                     */
1729                                                             /*     charno gives 0-based offset w/in info of 1st char  */
1730                                                             /*     of block. (iBlok.P points to :Info: divider token).*/
1731 
1732                Dinfo_.seg (k).L = length (Blok);            /*  length of block content (including any divider)       */
1733 
1734                Dinfo_.seg (k).info_name = Blok_names (j);   /* Name by which block was selected in CHECK_BLOCK_NAMES  */
1735                                                             /*  do-group above.                                       */
1736 
1737                if  ^(info_path.S.starname_info_name | info_path.S.separate_info_name)  then
1738                     go to NEXT_INFO_SEG;                    /* If condition true, only one block can match input spec */
1739 
1740 NEXT_BLOCK:    end CHECK_BLOCKS;
1741 
1742           if  ^some_block_foundS  then
1743 NO_BLOCK_MATCHES:
1744           do;
1745                if  info_path.S.starname_info_name  then
1746                     Dinfo_.seg (i).code = error_table_$nomatch;
1747                else Dinfo_.seg (i).code = error_table_$noentry;
1748                end NO_BLOCK_MATCHES;
1749 
1750           go to NEXT_INFO_SEG;
1751 
1752 %page;
1753 INFO_STRUCTURE (iFile_structure_INFO_SUBROUTINE_HCOM):      /* Subroutine Info Seg...                                 */
1754                                                             /*  to be treated in Dinfo_.seg list as a single block;   */
1755                                                             /*  but info_seg_ treats each :Entry: as a separate block.*/
1756           iBlokP = iFile.bloks.lastP;
1757           if  iBlokP ^= null () then                        /*   - Unthread history comment block from list           */
1758           if  iBlok.divider = iBlok_divider_hcom | iBlok.divider = iBlok_divider_hcom_obsolete  then do;
1759                call info_seg_$unthread_iBlok (iBlokP);
1760                Dinfo_.seg (k).L = Dinfo_.seg (k).L - length (Blok);
1761                end;                                         /*   - Remove HCom length from length of total info seg   */
1762                                                             /*     Blok starts at divider, and includes rest of block */
1763 
1764 INFO_STRUCTURE (iFile_structure_INFO_SUBROUTINE):           /* Subroutine Info Seg without History Comment...         */
1765 INFO_STRUCTURE (iFile_structure_SUBROUTINE):
1766           go to NEXT_INFO_SEG;                              /*   - Entire info segment (minus history comment)        */
1767                                                             /*     is the block to be displayed.                      */
1768 
1769 
1770 INFO_STRUCTURE (iFile_structure_NO_DIVIDERS):               /* Info Segment without blocks...                         */
1771           go to NEXT_INFO_SEG;                              /*   - Entire info segment is selected for display.       */
1772 
1773 
1774 BLOCKS_error:
1775           if  Dinfo_.seg (i).code ^= 0  then do;
1776                Dinfo_.seg (i).uid = "0"b;                   /* If error occurred during processing, mark              */
1777                Dinfo_.seg (i).I = 0;                        /* info to cause error message to be printed.             */
1778                Dinfo_.seg (i).E = "";
1779                end;
1780 
1781 NEXT_INFO_SEG:
1782           end EXAMINE_INFO_SEG;
1783      return;
1784 
1785 %page;
1786 free_dir_list:                                              /* Free storage allocated by hcs_$star_dir_list           */
1787           proc ();
1788 
1789           if  star_list_names_ptr ^= null ()  then
1790                free star_list_names in (hi_area);
1791           if  star_list_branch_ptr ^= null ()  then
1792                free star_dir_list_branch in (hi_area);
1793 
1794           end free_dir_list;
1795 %page;
1796 %include star_structures;
1797 %page;
1798 %include status_structures;
1799 
1800   dcl 1 branch aligned like status_branch;
1801 
1802      end get_info_seg_list;
1803 
1804 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1805 %page;
1806 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1807 
1808 numeric_date:
1809   procedure (bit_date) returns (fixed bin (71));
1810                                         /* This procedure converts a file system date     */
1811                                         /* to a numeric clock value.  A file system date  */
1812                                         /* is the high-order 36 bits of a 52 bit clock    */
1813                                         /* value.                                         */
1814 
1815     dcl bit_date       bit (36) unal,
1816         num_date       fixed bin (71);
1817 
1818 
1819     num_date = 0;
1820     substr (unspec (num_date), 21, 36) = bit_date;
1821     return (num_date);
1822 
1823   end numeric_date;
1824 
1825 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
1826 %page;
1827           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
1828           /*                                                                                                */
1829           /* ENTRYPOINT:  help_$init                                                                        */
1830           /*                                                                                                */
1831           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
1832 
1833 init:
1834      entry (procedure_name, search_list_name, search_list_ref_dir, Vrequired, Phelp_args, Acode);
1835 
1836   dcl  search_list_name char (*),                           /* Name of search list used in finding infos.     (input) */
1837        search_list_ref_dir char (*),                        /* Referencing dir used in  search rules.         (input) */
1838        Vrequired fixed bin;                                 /* Required version of help_args structure.       (input) */
1839 
1840      Phelp_args = null();                                   /* Initial values for our output arguments.               */
1841      Acode = 0;
1842 
1843      if  Vrequired ^= Vhelp_args_3  &  Vrequired ^= 2  &  Vrequired ^= 1 then  do;
1844           Acode = error_table_$unimplemented_version;       /* Complain if requested version unknown to this code.    */
1845           return;
1846           end;
1847 
1848 /* -----------------------------------------------------------------
1849    Create the help_ ssu_ subsystem.
1850    ----------------------------------------------------------------- */
1851 
1852   dcl  my_sciP ptr;
1853   dcl  NO_INFO_DIRECTORY char (0) int static options(constant) init("");
1854   dcl  NO_REQUEST_TABLE ptr int static options(constant) init(null());
1855   dcl  NULL_INFO_PTR ptr int static options(constant) init(null());
1856 
1857      my_sciP = null();                                      /* Prepare to cleanup ssu_ invocation if stack unwound    */
1858      on cleanup call init_janitor (my_sciP, Phelp_args);    /*  before help_$init returns to caller.                  */
1859 
1860      call ssu_$create_invocation (procedure_name, HELP_VERSION_02, NULL_INFO_PTR, NO_REQUEST_TABLE,
1861           NO_INFO_DIRECTORY, my_sciP, Acode);               /* help_ now runs in its own ssu_ subsystem.              */
1862      if  Acode ^= 0  then
1863           return;
1864 
1865 /* -----------------------------------------------------------------
1866    Get temporary segment (from ssu_) to hold help_args structure
1867    (and lots of other structures).
1868    ----------------------------------------------------------------- */
1869 
1870   dcl  HELP_ARGS_COMMENT char (9) int static options(constant) init("help_args");
1871 
1872      call ssu_$get_temp_segment (my_sciP, HELP_ARGS_COMMENT, Phelp_args);
1873                                                             /* Obtain a temporary segment: storage zeroed because     */
1874                                                             /*  $get_temp_segment truncates segment to 0-length and   */
1875                                                             /*  new pages added to segment are all zeros.             */
1876 
1877 /* -----------------------------------------------------------------
1878    Initialize 1st structure stored in temp segment: help_info (hi)
1879     - The help_info structure is declared in: _help_shared_data_.incl.pl1
1880       NOTE: Elements in help_info, their attributes, and overall size
1881             of help_info structure do not change, no matter how often the
1882             help_$help_ entry point is called.
1883    ----------------------------------------------------------------- */
1884 
1885      help_infoP = Phelp_args;                               /* help_info (hi) begins at base of temp seg (Position 1) */
1886 
1887      call ssu_$set_info_ptr (my_sciP, help_infoP);          /* Make addr(help_info) the ssu_ info_ptr passed to each  */
1888                                                             /*  help_ response program.                               */
1889 
1890      hi.init_ptrs = null();                                 /* Initialize help_info elements that are not zeroes:     */
1891      hi.help_ptrs = null();                                 /*  - .help_numbers, .help_video_data, .help_switches     */
1892      hi.help_video_data.video_iocbP = null();               /*    are already zeroed by ssu_$get_temp_segment.        */
1893      hi.info_ptrs = null();
1894      hi.help_labels = INIT_FAILED;
1895 
1896 
1897   dcl  HELP_AREA_IS_STANDARD_AREA ptr int static options(constant) init(null());
1898   dcl  HELP_AREA_TAG char (19) int static options(constant) init("help_ standard area");
1899 
1900      call ssu_$get_area (my_sciP, HELP_AREA_IS_STANDARD_AREA, HELP_AREA_TAG, hi.areaP);
1901                                                             /*  - .areaP points to area w/ "standard characteristics" */
1902 
1903 
1904      hi.sciP = my_sciP;                                     /*  - .sciP  points to help_'s ssu_ invocation.           */
1905 
1906 
1907      hi.init_ptrs.next_free_spaceP = help_infoP;            /*  - Free space in temp seg begins at base of segment.   */
1908 
1909      call set_space_used (currentsize (hi) );               /*     - Record length of help_info (hi) structure as     */
1910                                                             /*       "used space" in the temp segment.                */
1911 
1912 
1913 
1914 /* -----------------------------------------------------------------
1915    Initialize 2nd structure stored in temp segment: info_seg_data (isd)
1916     - The info_seg_data structure is declared in: info_seg_dcls_.incl.pl1
1917       It is the structure passed among info_seg_$XXX entrypoints.
1918    ----------------------------------------------------------------- */
1919 
1920   dcl 1 isd aligned like info_seg_data based (hi.isdP);
1921 
1922      hi.isdP = hi.next_free_spaceP;                         /* info_seg_data (isd) is next in temp seg   (Position 2) */
1923      isd.version = info_seg_data_version_01;                /*  - help_ calls info_seg_$initialize w/ this structure. */
1924      isd.standalone_invocationS = F;
1925      isd.ptrs = null();
1926      isd.relatives = null();
1927 
1928      isd.sciP = hi.sciP;                                    /*  - share help_'s ssu_ subsystem for errors, etc.       */
1929      isd.std_areaP = hi.areaP;                              /*  - share help_'s standard allocation area.             */
1930 
1931      call set_space_used (currentsize (isd));               /* Record length of info_seg_data (isd) structures as     */
1932                                                             /*  "used space" in the temp segment.                     */
1933 
1934 /* -----------------------------------------------------------------
1935    Initialize 3rd structure stored in temp segment: help_args
1936     - The help_args structure is declared in: help_args_.incl.pl1
1937    ----------------------------------------------------------------- */
1938 
1939      hi.help_argsP, Phelp_args = hi.next_free_spaceP;       /* help_args structure is next in temp seg   (Position 3) */
1940 
1941      help_args.version = Vrequired;                         /*    - Initialize other parts of help_args.              */
1942      help_args.Sctl = "0"b;
1943      help_args.Npaths = 0;
1944      help_args.Ncas = 0;
1945      help_args.Nsrhs = 0;
1946      help_args.min_Lpgh = INFO_LINES_PER_PARAGRAPH;
1947      help_args.max_Lpgh = get_page_length_$switch (null(), code);
1948                                                             /*    - Show more help output without prompting.          */
1949      help_args.Lspace_between_infos = INFO_BLANK_LINES_BEFORE_PARAGRAPH;
1950      help_args.min_date_time = -1;                          /*    - Selection of only infos modified after given time */
1951                                                             /*      is disabled by default.                           */
1952 
1953      help_args.sci_ptr = null();                            /*    - help_ no longer refers to these pointers.  Any    */
1954      help_args.help_data_ptr = null();                      /*      caller-provided ssu_ subsystem is ignored.        */
1955 
1956 /* -----------------------------------------------------------------
1957      - Get list of search paths in which help_ will look for
1958        info segments.
1959         - cleanup on-unit above releases all allocated storage.  (The
1960           entire hi_area is released by ssu_$destroy_invocation.)
1961      - Save list in: help_args.Nsearch_dirs and .search_dirs
1962    ----------------------------------------------------------------- */
1963 
1964      if  search_list_name ^= ""  then do;                   /*    - Initialize info_segment search paths.             */
1965           call search_paths_$get (search_list_name, sl_control_default, search_list_ref_dir, null(), addr(hi_area),
1966                sl_info_version_1, sl_info_p, Acode);
1967           if  Acode = 0  then do;
1968                help_args.Nsearch_dirs = sl_info.num_paths;  /*      Copy search paths to: help_args.search_dirs(*)    */
1969                if  help_args.Nsearch_dirs > 0  then
1970                     help_args.search_dirs (*) = sl_info.paths (*).pathname;
1971                free sl_info in (hi_area);                   /*      Free search_ paths_$get allocated storage.        */
1972                end;
1973           else help_args.Nsearch_dirs = 0;                  /*     - Failed to find named search paths.               */
1974           end;
1975      else help_args.Nsearch_dirs = 0;                       /*     - No search_paths name given?  Disable search paths*/
1976 
1977      call set_space_used (currentsize (help_args));         /* Record length of help_args structure as "used space"   */
1978                                                             /*  in the temp segment.  But caller will change size of  */
1979                                                             /*  by adding .path array elements.                       */
1980                                                             /* help_ recalculates this value each time it is called.  */
1981 
1982 /* -----------------------------------------------------------------
1983    At this point, help_args is fully initialized.
1984     - From this point on, our caller is responsible for calling
1985       help_$term if stack is unwound; no need to explicitly
1986       revert cleanup condition; return statement does that.
1987    ----------------------------------------------------------------- */
1988 
1989      return;                                                /* Return to caller of help_$init.                        */
1990 
1991 INIT_FAILED:
1992      call init_janitor (my_sciP, Phelp_args);
1993      return;
1994 
1995 
1996 init_janitor:
1997      proc (AsciP, Ahelp_argsP);
1998 
1999   dcl (AsciP, Ahelp_argsP) ptr;
2000 
2001      if  AsciP ^= null()  then
2002           call ssu_$destroy_invocation (AsciP);             /*  - Destroy help_ ssu_ subsystem.                       */
2003      Ahelp_argsP = null();                                  /*  - Set caller's Phelp_args pointer to null so caller   */
2004                                                             /*    does not try to call help_$term before help_args    */
2005                                                             /*    has been initialized.                               */
2006      end init_janitor;
2007 
2008 
2009 %page;
2010 %include "_help_shared_data_";
2011 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
2012 %page;
2013           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
2014           /*                                                                                                */
2015           /* ENTRYPOINT:  help_$term                                                                        */
2016           /*                                                                                                */
2017           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
2018 
2019 term:
2020      entry (procedure_name, Phelp_args, Acode);
2021 
2022      Acode = 0;                                             /* Set output parameter (which is never used).            */
2023 
2024      if Phelp_args = null then                              /* If pointer to help_args structure still null, then     */
2025           return;                                           /*  nothing to terminate.                                 */
2026 
2027      help_infoP = ptr (Phelp_args, 0);                      /* Access hidden help_info structure at base of temp seg  */
2028 
2029      if  hi.isdP ^= null()  then                            /* Terminate any info segments remaining initiated; and   */
2030           call info_seg_$terminate (addr(isd));             /*  release no-free areas created by info_seg_.           */
2031 
2032 
2033   dcl  needsDestruction bit(1) aligned;
2034 
2035      needsDestruction = (hi.sciP ^= null);                  /* Destroy help_ ssu_ subsystem.                          */
2036      call standalone_cleanup_handler (needsDestruction, hi.sciP);
2037                                                             /*  This routine is in: ssu_invoker_dcls_.incl.pl1        */
2038 
2039      Phelp_args = null();                                   /*  NOTE: The above call also releases the temp seg       */
2040                                                             /*        pointed to by Phelp_args.                       */
2041      return;
2042 
2043 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
2044 %page;
2045 %include arg_list;
2046 %page;
2047 %include help_args_;
2048 %page;
2049 %include help_cis_args_;
2050 %page;
2051 %include access_mode_values;
2052 %page;
2053 %include sl_info;
2054 
2055 %include sl_control_s;
2056 %page;
2057 %include ssu_invoker_dcls_;
2058 %page;
2059 %include ssu_prompt_modes;
2060 %page;
2061 %include system_constants;
2062 
2063   end help_;