*copyc osd$default_pragmats
?? NEWTITLE := 'NOS/VE REMOTE HOST' ??
MODULE rhm$input_file_receive;

?? NEWTITLE := 'GLOBAL TYPE DECLARATIONS' ??
?? SET (LIST := OFF) ??
?? EJECT ??
?? SET (LIST := ON) ??
*copyc rhc$condition_limits
*copyc rhc$constants
*copyc rhd$nos_ve_types
*copyc tmc$wait_times
*copyc osc$dual_state_batch
?? TITLE := 'PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := OFF) ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$put_next
*copyc amp$return
*copyc amp$rewind
*copyc amp$set_segment_eoi
*copyc amp$set_segment_position
*copyc jmp$submit_job
*copyc mlp$receive_message
*copyc mlp$send_message
*copyc osp$format_message
*copyc pmp$get_170_os_type
*copyc pmp$get_unique_name
*copyc pmp$log
*copyc pmp$long_term_wait
*copyc rhp$set_status_abnormal
*copyc rhv$signal
*copyc syp$memory_link_data_conversion
?? TITLE := 'LOG_STATUS' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ LOG_STATUS
{
{        The purpose of this procedure is to format and log an error
{ to the job log.
{
{         LOG_STATUS (MESSAGE_STATUS, STATUS)
{
{ MESSAGE_STATUS: (input) This parameter contains the status to format and
{                 write to the job log.
{
{ STATUS: (output) This parameter returns the success or failure of logging
{         the error.
{

  PROCEDURE log_status
    (    message_status: ost$status;
     VAR status: ost$status);

    VAR
      message: ost$status_message,
      message_area: ^ost$status_message,
      message_line_count: ^ost$status_message_line_count,
      message_line_index: 1 .. osc$max_status_message_lines,
      message_line_size: ^ost$status_message_line_size,
      message_line: ^string ( * ),
      page_width: ost$status_message_line_size;


    status.normal := TRUE;
    page_width := osc$max_status_message_line;
    osp$format_message (message_status, osc$full_message_level, page_width,
          message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    message_area := ^message;
    RESET message_area;
    NEXT message_line_count IN message_area;
    FOR message_line_index := 1 TO message_line_count^ DO
      NEXT message_line_size IN message_area;
      NEXT message_line: [message_line_size^] IN message_area;
      pmp$log (message_line^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND log_status;

?? TITLE := 'CONVERT_ASCII812_TO_ASCII88' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ CONVERT_ASCII812_TO_ASCII88
{
{       The purpose of this procedure is to convert an A170 8/12 ascii string
{ to an 8/8 ascii string.
{
{       CONVERT_ASCII812_TO_ASCII88 (ASCII812_STRING,
{                ASCII88_STRING, CONVERSION_STATUS)
{
{ ASCII812_STRING: (input) This parameter contains the 8/12 ascii string which
{                 is to be converted.
{
{ ASCII88_STRING: (output) This parameter contains the 8/8 ascii string which
{                  is the result of the conversion.
{
{ CONVERSION_STATUS: (output) This parameter indicates the success or failure
{                    the conversion.  If the output string is not large enough
{                    of to complete the conversion of the entire input string
{                    then a status of non_fatal_error will be returned
{                    otherwise
{                    the conversion will be successful.  In either case,
{                    conversion of as much of the string as is possible
{                    will be performed.
{

  PROCEDURE convert_ascii812_to_ascii88
    (    ascii812_string: array [ * ] of rht$c180_ascii812_word;
     VAR ascii88_string: string ( * );
     VAR conversion_status: rht$status);

    VAR
      ascii812_char_index: 2 .. 5,
      ascii812_string_lbound: integer,
      ascii812_string_length: integer,
      ascii812_string_ubound: integer,
      ascii88_char_index: 0 .. 256,
      ascii88_string_length: 0 .. 256,
      chars_in_last_word: 1 .. 5,
      last_word_index: integer,
      word_index: integer;

    ascii812_string_lbound := LOWERBOUND (ascii812_string);
    ascii812_string_ubound := UPPERBOUND (ascii812_string);
    ascii812_string_length := ascii812_string_ubound - ascii812_string_lbound +
          1;
    ascii88_string_length := STRLENGTH (ascii88_string);
    IF ascii812_string_length * 5 > ascii88_string_length THEN
      last_word_index := ascii812_string_lbound +
            (ascii88_string_length + 4) DIV 5 - 1;
      chars_in_last_word := ascii88_string_length -
            ((ascii88_string_length + 4) DIV 5 - 1) * 5;
      conversion_status := non_fatal_error;
    ELSE
      last_word_index := ascii812_string_ubound;
      chars_in_last_word := 5;
      conversion_status := successful;
    IFEND;
    ascii88_char_index := 0;
    FOR word_index := ascii812_string_lbound TO last_word_index - 1 DO
      ascii88_char_index := ascii88_char_index + 1;
      ascii88_string (ascii88_char_index) :=
            ascii812_string [word_index].ascii812_char1.ascii88_char;
      FOR ascii812_char_index := 2 TO 5 DO
        ascii88_char_index := ascii88_char_index + 1;
        ascii88_string (ascii88_char_index) :=
              ascii812_string [word_index].ascii812_char2_5 [
              ascii812_char_index].ascii88_char;
      FOREND;
    FOREND;
    ascii88_char_index := ascii88_char_index + 1;
    ascii88_string (ascii88_char_index) :=
          ascii812_string [last_word_index].ascii812_char1.ascii88_char;
    FOR ascii812_char_index := 2 TO chars_in_last_word DO
      ascii88_char_index := ascii88_char_index + 1;
      ascii88_string (ascii88_char_index) :=
            ascii812_string [last_word_index].
            ascii812_char2_5 [ascii812_char_index].ascii88_char;
    FOREND;

  PROCEND convert_ascii812_to_ascii88;

?? TITLE := 'route_file' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ ROUTE_FILE
{
{     The purpose of this procedure is to provide a means by which
{ a CYBIL procedure can route a local file to a system queue.
{
{           ROUTE_FILE (EXEC_TYPE,LOCAL_FILE_INFO,QUEUE_FILE_INFO,ROUTE_STATUS)
{
{ EXEC_TYPE: (input) This parameter specifies the type of queue file transfer
{             exec which is requesting the file route.
{
{ LOCAL_FILE_INFO: (input) This parameter specifies all information
{                  pertinent to local file access.
{
{ QUEUE_FILE_INFO: (input) This parameter communicates all queue file
{                  attributes needed for IRHF routing.
{
{ ROUTE_STATUS: (output) This parameter indicates to the calling
{               procedure the completion status of the route function,
{               i.e. the success or failure of the route.  The
{               following status values may be returned by this
{               request:     unsuccessful
{                            successful
{                            fatal_error
{

  PROCEDURE route_file
    (    exec_type: rht$irhf_exec_types;
     VAR local_file_info: rht$local_file_info;
         queue_file_info: rht$queue_file_info;
     VAR route_status: ost$status);

    VAR
      conversion_status: rht$status,
      job_submission_options_p: ^jmt$job_submission_options,
      msg_status: ost$status,
      system_supplied_name: jmt$system_supplied_name;

    PUSH job_submission_options_p: [1 .. 4];
    job_submission_options_p^ [1].key := jmc$origin_application_name;
    job_submission_options_p^ [1].origin_application_name :=
          osc$dual_state_batch;
    job_submission_options_p^ [2].key := jmc$source_logical_id;
    job_submission_options_p^ [2].source_logical_id := '';
    job_submission_options_p^ [3].key := jmc$implicit_routing_text;
    PUSH job_submission_options_p^ [3].implicit_routing_text;
    job_submission_options_p^ [3].implicit_routing_text^.text := ' ';
    job_submission_options_p^ [3].implicit_routing_text^.size :=
          queue_file_info.c180.implicit_text_size;
    job_submission_options_p^ [4].key := jmc$output_destination_usage;
    job_submission_options_p^ [4].output_destination_usage :=
          jmc$dual_state_usage;

{ NOTE: There MUST be a value in the source_logical_id (NOS LID)
{       field or the call to jmp$submit_job will fail.

{ NOTE: The (1,3) must be here to limit the convert procedure from writing
{       into more than three characters - the convert will otherwise use a
{       multiple of five (for a total of five characters).

    convert_ascii812_to_ascii88 (queue_file_info.c180.logical_identifier.
          a170_logical_identifier, job_submission_options_p^ [2].
          source_logical_id (1, 3), conversion_status);

    IF queue_file_info.c180.implicit_text_size <> 0 THEN
      convert_ascii812_to_ascii88 (queue_file_info.c180.implicit_routing_text,
            job_submission_options_p^ [3].implicit_routing_text^.
            text (1, queue_file_info.c180.implicit_text_size),
            conversion_status);
    IFEND;

    jmp$submit_job (local_file_info.local_file_name, job_submission_options_p,
          system_supplied_name, route_status);

  PROCEND route_file;

?? TITLE := 'RHP$QUEUE_FILE_RECEIVE_EXEC' ??
?? EJECT ??

{ RHP$QUEUE_FILE_RECEIVE_EXEC
{
{     This procedure is responsible for receiving queue files from
{ its partner application.  This includes the responsibilities of
{ protocol maintenance, reception control, and final file disposition.
{
{     RHP$QUEUE_FILE_RECEIVE_EXEC (APPLICATION_NAMES,
{               DATA_BUFFER_POINTER,EXEC_STATUS
{
{ APPLICATION_NAMES: (input) This parameter contains the sending and
{     receiving application names required for MLI communications.
{
{ DATA_BUFFER_POINTER: (input) This parameter contains the address
{     of a buffer that will be used to receive data.
{
{ EXEC_STATUS: (output) This parameter indicates to the calling procedure
{     the processing status of the executive.  The following status
{     values may be returned:
{               beginning
{               middle
{               unrecoverable_error

  PROCEDURE [XDCL] rhp$queue_file_receive_exec ALIAS 'rhmqre'
    (VAR application_names: rht$mli_application_names;
         data_buffer_pointer: rht$file_data_buffer_pointer;
     VAR exec_status: rht$exec_status);

    TYPE
      receive_states = (fetch_control, fetch_data, write_file, dispose,
            respond);

    CONST
      boi = rhc$beginning_of_information,
      completed = rhc$completed,
      delete_file = rhc$delete_file,
      eoi = rhc$end_of_information,
      err = rhc$error,
      moi = rhc$middle_of_information,
      rhc$63_character_set = 'C';

    VAR
      arbitrary_info: mlt$arbitrary_info,
      character_set_conversion_word: array [1 .. 1] of rht$c180_ascii812_word,
      character_set_type: string (5),
      conversion_info: syt$conversion_info,
      conversion_message_length: integer,
      conversion_status: rht$status,
      local_file_info: [STATIC] rht$local_file_info,
      message_length: mlt$message_length,
      msg_status: ost$status,
      open_attr: array [1 .. 5] of amt$access_selection,
      os_type: ost$170_os_type,
      purged_file: ost$name,
      quanta_work_completed: boolean,
      queue_file_info: [STATIC] rht$queue_file_info,
      receive_state: [STATIC] receive_states := fetch_control,
      receive_status: [STATIC] (ok, error) := ok,
      segment_pointer: amt$segment_pointer,
      sender_application_name: mlt$application_name,
      status: ost$status;

{ * * * * * * *   R E C E I V E   A   Q U E U E   F I L E   * * * * * * *

    quanta_work_completed := FALSE;

  /communication_loop/
    REPEAT
      CASE receive_state OF

{ Receive control information.

      = fetch_control =
        mlp$receive_message (application_names.application.application_name,
              arbitrary_info, rhv$signal, ^queue_file_info.equalizer,
              message_length, #SIZE (queue_file_info.equalizer), 0
              {Index for pending msg} , sender_application_name, status);
        IF status.normal THEN
          CASE arbitrary_info OF
          = boi =
            receive_status := ok;
            receive_state := fetch_data;
            exec_status := middle;
            pmp$get_unique_name (local_file_info.local_file_name, status);
            IF NOT status.normal THEN
              log_status (status, msg_status);
              local_file_info.local_file_name := 'rh_qre_receive_file';
            IFEND;
            open_attr [1].key := amc$open_position;
            open_attr [1].open_position := amc$open_at_boi;
            open_attr [2].key := amc$record_type;
            open_attr [2].record_type := amc$variable;
            open_attr [3].key := amc$access_mode;
            open_attr [3].access_mode := $pft$usage_selections
                  [pfc$append, pfc$shorten, pfc$modify, pfc$read];
            open_attr [4].key := amc$file_organization;
            open_attr [4].file_organization := amc$sequential;
            open_attr [5].key := amc$block_type;
            open_attr [5].block_type := amc$system_specified;
            amp$open (local_file_info.local_file_name, amc$segment, ^open_attr,
                  local_file_info.file_identifier, status);
            IF status.normal THEN
              amp$get_segment_pointer (local_file_info.file_identifier,
                    amc$sequence_pointer, segment_pointer, status);
            IFEND;
            IF NOT status.normal THEN
              log_status (status, msg_status);
              receive_state := dispose;
              receive_status := error;
            IFEND;
            conversion_info.file_pointer := segment_pointer.sequence_pointer;
            RESET conversion_info.file_pointer;
            conversion_info.save_area := 0;
            character_set_conversion_word [1].ascii812_char1 :=
                  queue_file_info.c180.form_code_char1;
            convert_ascii812_to_ascii88 (character_set_conversion_word,
                  character_set_type, conversion_status);
            IF character_set_type (1) = rhc$63_character_set THEN
              conversion_info.conversion_type := syc$63_char_ascii_to_ascii;
            ELSE
              conversion_info.conversion_type := syc$64_char_ascii_to_ascii;
            IFEND;
          = moi, eoi, err =
            quanta_work_completed := TRUE;
          ELSE
            exec_status := unrecoverable_error;
            quanta_work_completed := TRUE
          CASEND;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            exec_status := beginning;
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            exec_status := unrecoverable_error;
          CASEND;
          quanta_work_completed := TRUE;
        IFEND;

{ Receive data from transmitter.

      = fetch_data =
        pmp$get_170_os_type (os_type, status);
        IF status.normal THEN
          IF os_type = osc$ot7_dual_state_nos_be THEN
            mlp$receive_message (application_names.application.
                  application_name, arbitrary_info, rhv$signal,
                  data_buffer_pointer, message_length,
                  #SIZE (data_buffer_pointer^), 0 {index for any pending msg} ,
                  sender_application_name, status);
          ELSE
            mlp$receive_message (application_names.application.
                  application_name, arbitrary_info, rhv$signal,
                  data_buffer_pointer, message_length,
                  #SIZE (data_buffer_pointer^) - #SIZE (integer), 0
                  {index for any pending msg} , sender_application_name,
                  status);
          IFEND;
        ELSE
          log_status (status, msg_status);
          receive_status := error;
          exec_status := unrecoverable_error;
          receive_state := dispose;
        IFEND;
        IF status.normal THEN
          CASE arbitrary_info OF
          = moi, eoi =
            receive_state := write_file;
          = err =
            receive_status := error;
            exec_status := beginning;
            receive_state := dispose;
          ELSE
            receive_status := error;
            exec_status := unrecoverable_error;
            receive_state := dispose;
          CASEND;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            pmp$long_term_wait (tmc$infinite_wait, 5000);
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            receive_status := error;
            exec_status := unrecoverable_error;
            receive_state := dispose;
          CASEND;
        IFEND;

{ Write data to local file.

      = write_file =
        IF message_length > 0 THEN
          conversion_message_length := message_length DIV 8;
          syp$memory_link_data_conversion (^conversion_info,
                data_buffer_pointer, conversion_message_length);
        IFEND;
        IF arbitrary_info = eoi THEN
          segment_pointer.sequence_pointer := conversion_info.file_pointer;
          amp$set_segment_eoi (local_file_info.file_identifier,
                segment_pointer, status);
          IF NOT status.normal THEN
            log_status (status, msg_status);
            receive_status := error;
          IFEND;
          receive_state := dispose;
        ELSE
          receive_state := fetch_data;
        IFEND;

{ Route local file to input queue.

      = dispose =
        amp$close (local_file_info.file_identifier, status);
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;
        IF receive_status = ok THEN
          route_file (receive_exec, local_file_info, queue_file_info, status);
          IF status.normal THEN
            arbitrary_info := completed;
          ELSEIF status.condition = jme$maximum_jobs THEN
            arbitrary_info := err;
          ELSE
            log_status (status, msg_status);
            arbitrary_info := delete_file;
          IFEND;
          message_length := 0;
          receive_state := respond;
        ELSE
          IF exec_status = middle THEN
            arbitrary_info := err;
            message_length := 0;
            receive_state := respond;
          ELSE
            receive_status := ok;
            receive_state := fetch_control;
            quanta_work_completed := TRUE;
          IFEND;
        IFEND;
        amp$return (local_file_info.local_file_name, status);
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;

{ Tell transmitter status of processing the file.

      = respond =
        mlp$send_message (application_names.application.application_name,
              arbitrary_info, rhv$signal, data_buffer_pointer, message_length,
              application_names.destination.application_name, status);
        IF status.normal THEN
          receive_status := ok;
          receive_state := fetch_control;
          exec_status := beginning;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail =
            exec_status := middle;
            pmp$long_term_wait (1000, 1000);
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            receive_status := ok;
            receive_state := fetch_control;
            exec_status := beginning;
          CASEND;
        IFEND;
        quanta_work_completed := TRUE;
      CASEND;
    UNTIL quanta_work_completed; {/communication_loop/

  PROCEND rhp$queue_file_receive_exec;

MODEND rhm$input_file_receive;
