
*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := '170 NOS/VE REMOTE HOST' ??
MODULE rhmwtf;

?? NEWTITLE := 'GLOBAL TYPE DECLARATIONS' ??
?? SET (LIST := OFF) ??
?? EJECT ??
*copyc RHT$FUNCTION_STATUS
*copyc MLD$MEMORY_LINK_DECLARATIONS

?? TITLE := 'EXTERNAL PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := OFF) ??
?? EJECT ??
*copyc ZN7PCIO
*copyc RHP$LOG_STATUS

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

{ WRITE_TO_LF
{
{     The purpose of this procedure is to write a data message to
{ a local file.  Included in this function is the responsibility
{ to perform any required reformatting of information; i.e.,
{ change message from interchange format to host target format.
{
{     WRITE_TO_LF (LOCAL_FILE_INFO,DATA_BUFFER,MESSAGE_LENGTH,WRITE_STATUS)
{
{ LOCAL_FILE_INFO: (input) This parameter specifies all information
{     pertinent to file access.
{
{ DATA_BUFFER: (input) This parameter is the area in which the
{     data message is contained.
{
{ MESSAGE_LENGTH: (input) This parameter specifies the length in
{     words of the data message contained in the data buffer.
{
{ WRITE_STATUS: (output) This parameter specifies the write
{     request status.  The following status values may be returned
{     by this request:
{                successful
{                non_fatal_error
{

  PROCEDURE [XDCL] write_to_lf (VAR local_file_info: rht$local_file_info;
    VAR data_buffer: rht$file_data_buffer;
    VAR message_length: mlt$message_length;
    VAR write_status: rht$status);

    TYPE
      a170_writecw_pru_header_rec = packed record
        bits24_59: writecw_pru_header_bits24_59,
        block_length: 0 .. 0ffffff(16),
      recend,
      a170_pru_header_interchange_rec = packed record
        bits22_59: 0 .. 3fffffffff(16),
        block_length: 0 .. 3fffff(16),
      recend,
      writecw_pru_header_bits24_59 = packed record
        p: boolean,
        filler1: 0 .. 0f(16),
        c: boolean,
        pru_size: 0 .. 3ffff(16),
        filler2: 0 .. 3f(16),
        ubc: 0 .. 3f(16),
      recend;

    CONST
      disk_pru_size = 64;

    VAR
      bits24_59: [STATIC] writecw_pru_header_bits24_59 := [FALSE, 0, FALSE, disk_pru_size, 0, 0],
      a170_writecw_pru_header_ptr: ^a170_writecw_pru_header_rec,
      a170_pru_header_interchange_ptr: ^a170_pru_header_interchange_rec,
      header_word_index: 1 .. rhc$max_message_length,
      i: integer;

    header_word_index := 1;
    WHILE header_word_index < message_length DO
      a170_writecw_pru_header_ptr := #LOC (data_buffer [header_word_index]);
      a170_pru_header_interchange_ptr := #LOC (data_buffer [header_word_index]);
      header_word_index := header_word_index + a170_pru_header_interchange_ptr^.block_length + 1;
      a170_writecw_pru_header_ptr^.block_length := (a170_pru_header_interchange_ptr^.block_length - 1) * 5;
      a170_writecw_pru_header_ptr^.bits24_59 := bits24_59;
    WHILEND;
    FOR i := 1 TO 22 DO
      local_file_info.fet.fet1_22 [i] := 0;
    FOREND;
    local_file_info.fet.completed := TRUE;
    local_file_info.fet.error_processing := TRUE;
    local_file_info.fet.first := #LOC (data_buffer);
    local_file_info.fet.next_in := #LOC (data_buffer [message_length + 1]);
    local_file_info.fet.next_out := #LOC (data_buffer);
    local_file_info.fet.limit := #LOC (data_buffer [rhc$max_message_length + 1]);
    n7p$cio (local_file_info.fet, - n7c$cio_writecw);
    IF local_file_info.fet.abnormal_termination <> 0 THEN
      write_status := non_fatal_error;
      log_status (dayfile_log, 'cio error, file receive abort');
    ELSE
      write_status := successful;
    IFEND;
    RETURN;

  PROCEND write_to_lf;

MODEND rhmwtf;
