*copyc osd$default_pragmats
?? NEWTITLE := '170 NOS/VE REMOTE HOST' ??
MODULE rhm$queue_file_exec ALIAS 'rhmqep';

{
{     The purpose of this module is to allow for sharing of
{ execution time between three independent processes.  These
{ processes include transfer of input queue files from A170
{ to C180, receiving and routing of output queue files from
{ C180 to A170 and partner job exec which submits permanent
{ file transfer jobs for a C180 task.
{     The remote_host_queue_file_exec_pgm monitors the three
{ processes' status and provides for a graceful degredation
{ of the remote host in the event any of the processes
{ detects a fatal error.
{

?? NEWTITLE := 'GLOBAL TYPE DECLARATIONS' ??
?? SET (LIST := OFF) ??
?? EJECT ??

*copyc rht$function_status
*copyc rhc$constants

?? TITLE := 'EXTERNAL PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := OFF) ??
?? EJECT ??
*copyc rhp$log_status
*copyc rhp$170_mli_link
*copyc rhp$wait
*copyc rhp$qf_170_transmit_exec
*copyc rhp$qf_170_receive_exec
*copyc FZMARK
*copyc LGZCLOS
*copyc LGZGET
*copyc LGZOPEN
*copyc ZUTPS2D
?? TITLE := 'VARIABLES GLOBAL TO THIS MODULE' ??
?? SET (LIST := ON) ??
?? EJECT ??

  PROCEDURE [XREF] initmli (i: integer);

  PROCEDURE [XREF] paws (i: integer);

  PROCEDURE [XREF] qfwait;
{
{  The following variable defines the value of the signal option parameter
{    for all mli send/receive requests issued by the irhf c170 queue file
{routines.
{
    CONST max_lid_words = 10;

    TYPE
      lid_record = record
        case i: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          lid_rec: packed record
            lids: 0 .. 3fffffff(16),
            filler: 0 .. 3fffffff(16),
          recend,
        casend,
      recend;


  VAR
    signal_record: [STATIC] mlt$signal_record := [0, * , * ],
    short_paws: integer := 0,
    rhv$signal: [XDCL, STATIC] mlt$signal := ^signal_record;

?? TITLE := 'REMOTE_HOST_QUEUE_FILE_EXEC_PGM' ??
?? EJECT ??

  PROGRAM remote_host_queue_file_exec_pgm;

    TYPE
      index_list_element = record
        forward_ptr: 1 .. 2,
        backward_ptr: 1 .. 2,
      recend,
      work_set = set of 1 .. 2;

    VAR
      application_names: [STATIC] array [1 .. 2] of rht$mli_application_names
        := [[[a170_id, [rhc$send_input_to_remote, 0]], [a170_id,
        [rhc$receive_remote_input, 0]]], [[a170_id, [rhc$receive_remote_output,
        0]], [a170_id, [rhc$send_output_to_remote, 0]]]],
      exec_list: [STATIC] array [1 .. 2] of rht$irhf_exec_types :=
        [transmit_exec, receive_exec],
      index_list: [STATIC] array [1 .. 2] of index_list_element := [[2, 2], [1,
        1]],
      exec_index: [STATIC] 1 .. 2 := 2,
      work_avail: [STATIC] work_set := $work_set [1, 2],
      exec_count: [STATIC] array [1 .. 2] of integer := [REP 2 of 0],
      lid_list: rht$lid_list,
      exec_status: [STATIC] array [1 .. 2] of rht$exec_status := [REP 2 of
        beginning];


    initmli (0);
    mli_link (on, application_names [1]);
    mli_link (on, application_names [2]);
    read_alt_lid_list (lid_list);
    log_status (dayfile_log_and_display, 'NOSVE IRHF PROCESSING');

    WHILE TRUE DO
      exec_index := index_list [exec_index].forward_ptr;
      IF exec_count [exec_index] = 0 THEN
        CASE exec_list [exec_index] OF
        = transmit_exec =
          rhp$queue_file_transmit_exec (application_names [1], exec_status
                [1], ^lid_list);
        = receive_exec =
          rhp$queue_file_receive_exec (application_names [2], exec_status [2]);
        CASEND;
        exec_count [exec_index] := 10;
      ELSE

{ execute an idle task once for every ten executes of an active task

        exec_count [exec_index] := exec_count [exec_index] - 1;
      IFEND;
      IF exec_status [exec_index] = middle THEN
        work_avail := work_avail + $work_set [exec_index];
        exec_count [exec_index] := 0; {force execute}
        short_paws := 0;
      ELSE
        work_avail := work_avail - $work_set [exec_index];
      IFEND;

      IF exec_status [exec_index] = unrecoverable_error THEN
        exec_status [exec_index] := middle;
      IFEND;

      IF work_avail = $work_set [] THEN

{ no qf work to do - go idle (rollout/recall)

        IF short_paws < 2 THEN
          paws (20); {20*30ms=.6 seconds}
          short_paws := short_paws + 1;
        ELSE
          qfwait; {rollout}
          short_paws := 0;
        IFEND;
        exec_count [1] := 0; {force all execute}
        exec_count [2] := 0; {force all execute}
      IFEND;
    WHILEND;

  PROCEND remote_host_queue_file_exec_pgm;

  PROCEDURE read_alt_lid_list (VAR lid_list: rht$lid_list);

    CONST lid_skeleton_file = 'lidlist';

    VAR lid_file: file,
        lid_conv_buffer: lid_record,
        lid: string (3),
        lid_word: string (10),
        mark: file_mark,
        lid_word_index : integer,
        lid_index: integer,
        num_of_chars_read: integer,
        dc_string_word_index: integer,
        dc_string_char_index: 0 .. 9,
        source_index: ost$string_index,
        eol: boolean;

{  Initialize lid table list to 0.
     FOR lid_index := 1 TO 10 DO
       lid_list [lid_index].lid1 := 0;
       lid_list [lid_index].lid2 := 0;
     FOREND;

     lid_word := ' ';

{  Open the lid file and read the LIDs into the table.

     LG#OPEN (lid_file, lid_skeleton_file, old#, input#, first#);
     lid_word_index := 1;
     lid_index := 1;

{  Each lid will be read in one at a time and a string of 9 characters
{  will be created.  This string will be converted to a dc string in
{  order to form the alternate lid list needed to route jobs from NOS
{  on one mainframe to NOS/VE on another one.

     /read_loop/
     REPEAT
       LG#GET (lid_file, num_of_chars_read, lid);
       F#MARK (lid_file, mark);
       IF mark = data# THEN
         lid_word (lid_index, 3) := lid;
         IF lid_index < 7 THEN
           lid_index := lid_index + 3;
         ELSE
           lid_index := 1;
           dc_string_word_index := 1;
           dc_string_char_index := 0;
           source_index := 1;
           eol := FALSE;
           { convert and insert the first 5 characters into the lid list.
           utp$convert_string_to_dc_string (utc$ascii64,
               lid_conv_buffer.dc_string, dc_string_word_index,
               dc_string_char_index, lid_word(1,5), source_index, eol);
           lid_list [lid_word_index].lid1 := lid_conv_buffer.lid_rec.lids;
           dc_string_word_index := 1;
           dc_string_char_index := 0;
           source_index := 1;
           eol := FALSE;
           { convert and insert the last 5 characters into the lid list.
           utp$convert_string_to_dc_string (utc$ascii64,
               lid_conv_buffer.dc_string, dc_string_word_index,
               dc_string_char_index, lid_word(6,5), source_index, eol);
           lid_list [lid_word_index].lid2 := lid_conv_buffer.lid_rec.lids;
           lid_word_index := lid_word_index + 1;
           IF lid_word_index > 10 THEN
             log_status (dayfile_log, 'Lid list is full, see documentation');
             EXIT /read_loop/;
           IFEND;
           lid_word := ' ';
         IFEND;
       IFEND;
     UNTIL mark <> data#;  { read_loop }
     IF lid_index <> 1 THEN  { check for lids not creating a full word. }
       dc_string_word_index := 1;
       dc_string_char_index := 0;
       source_index := 1;
       eol := FALSE;
       { convert and insert the first 5 characters into the lid list.
       utp$convert_string_to_dc_string (utc$ascii64,
           lid_conv_buffer.dc_string, dc_string_word_index,
           dc_string_char_index, lid_word(1,5), source_index, eol);
       lid_list [lid_word_index].lid1 := lid_conv_buffer.lid_rec.lids;
       dc_string_word_index := 1;
       dc_string_char_index := 0;
       source_index := 1;
       eol := FALSE;
       { convert and insert the last 5 characters into the lid list.
       utp$convert_string_to_dc_string (utc$ascii64,
           lid_conv_buffer.dc_string, dc_string_word_index,
           dc_string_char_index, lid_word(6,5), source_index, eol);
       lid_list [lid_word_index].lid2 := lid_conv_buffer.lid_rec.lids;
     IFEND;
     LG#CLOSE (lid_file, first#);
  PROCEND read_alt_lid_list;

MODEND rhm$queue_file_exec;
