*copyc OSD$DEFAULT_PRAGMATS
MODULE iim$st_put;
?? NEWTITLE := 'MODULE iim$st_put' ??

?? PUSH (LISTEXT := ON) ??
*copyc amc$fap_request_codes
*copyc AME$PUT_VALIDATION_ERRORS
*copyc AMT$FILE_BYTE_ADDRESS
*copyc AMT$FILE_IDENTIFIER
*copyc AMT$TERM_OPTION
*copyc AMT$WORKING_STORAGE_LENGTH
*copyc ifc$interrupt_timesharing_io
*copyc ife$error_codes
*copyc IIK$KEYPOINTS
*copyc IIT$CONNECTION_DESCRIPTION
*copyc IIT$INTERACTIVE_SIGNAL_TYPE
*copyc IIV$CONNECTION_DESC_PTR
*copyc IIV$INTERACTIVE_TERMINATED
*copyc IIV$INT_TASK_OPEN_FILE_COUNT
*copyc IIV$OUTPUT
*copyc NAT$DATA_FRAGMENTS
*copyc OST$ACTIVITY_STATUS
*copyc OST$STATUS
*copyc pmp$log
?? POP ??

*copyc amp$put_next
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc IIP$CLEAR_LOCK
*copyc IIP$REPORT_STATUS_ERROR
*copyc iip$search_connection_desc
*copyc IIP$SET_LOCK
*copyc IIP$ST_FLUSH
*copyc iip$xt_redirect_xterm_output
*copyc I#COMPARE
*copyc I#MOVE
*copyc iiv$io_requests_in_job
*copyc iiv$io_requests_in_task
*copyc iiv$xt_xterm_control_block
*copyc osp$decrement_locked_variable
*copyc OSP$ESTABLISH_CONDITION_HANDLER
*copyc osp$set_status_abnormal
*copyc OSP$SET_STATUS_FROM_CONDITION
*copyc osp$system_error
*copyc OSP$TEST_SIG_LOCK
*copyc osv$task_private_heap
*copyc PMP$CONTINUE_TO_CAUSE
*copyc pmp$get_executing_task_gtid
*copyc PMP$LOG
*copyc PMP$TASK_DEBUG_MODE_ON

?? NEWTITLE := 'PROCEDURE iip$st_put', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$st_put (file_id: amt$file_identifier;
        open_file_desc_pointer: ^iit$st_open_file_description;
        operation: amt$fap_operation;
        working_storage_area: ^cell;
        working_storage_length: amt$working_storage_length;
        byte_address: ^amt$file_byte_address;
        term_option: amt$term_option;
    VAR status: ost$status);

    VAR
      decrement_error: boolean,
      exit_in_progress: boolean,
      add_space: boolean,
      allocate_length: integer,
      connection_desc_ptr: ^iit$connection_description,
      current_transfer_count: amt$transfer_count,
      data_length: 0 .. osc$max_segment_length,
      direct_move: boolean,
      downline_queue_entry_ptr: ^iit$st_downline_queue_entry,
      global_task_id: ost$global_task_id,
      io_requests_in_job: integer,
      local_status: ost$status,
      ls: ost$signature_lock_status,
      move_length: integer,
      output_sequence_pointer: ^iit$st_output,
      put_byte_address: amt$file_byte_address,
      saved_attributes: iit$connection_attributes,
      save_last_term_option: amt$term_option,
      working_storage_array_pointer: ^array [0 .. iic$max_record_length] of char;

     ?? OLDTITLE ??
     ?? EJECT ??
{  If a call is made to a procedure that will go into wait with the lock
{  set then the lock must be protected with a block exit handler.


  /put_data/
    BEGIN
      exit_in_progress := FALSE;
      #spoil (exit_in_progress);

{ The xterm task cannot do output to the terminal.  The xterm task output
{ is redirected to a mass storage file.  In most cases the xterm task attempts
{ to do output when the communications software cannot accept output.
{ The terminal user may examine the mass storage file to see the xterm output.
{ Usually the xterm task only does output when a failure occurs.

      pmp$get_executing_task_gtid (global_task_id);
      IF (iiv$xt_xterm_control_block.task.exists AND (global_task_id =
            iiv$xt_xterm_control_block.xterm_global_task_id)) THEN
        iip$xt_redirect_xterm_output (working_storage_area, working_storage_length,status);
        RETURN;
      IFEND;

      iip$search_connection_desc (open_file_desc_pointer^.session_layer_file_name, connection_desc_ptr);
        IF connection_desc_ptr = NIL THEN
          osp$set_status_abnormal (ifc$interactive_facility_id, ife$file_is_not_network_file, '', status);
          EXIT /put_data/;
        IFEND;

      osp$test_sig_lock (iiv$downline_queue_lock, ls);
      IF (ls = osc$sls_locked_by_current_task) THEN

      { Some sort of unintended recursion has occured (due to break, escape,
      { task/job termination, etc.  Return with normal status.

        status.normal := TRUE;
        EXIT /put_data/;
      IFEND;
      status.normal := TRUE;

    { Return an error if at EOR and the operation is a put partial continue.

      IF (iiv$put_info.last_term_option = amc$terminate) AND (term_option =
            amc$continue) THEN
        amp$set_file_instance_abnormal (file_id, ame$improper_continue,
              operation, '', status);
        EXIT /put_data/;
      IFEND;

    { Terminate the previous record if at mid-record and the operation
    { is a full put or a put partial start.
    { The reader should be aware that a recursive call to iip$st_put is made here.

      IF (iiv$put_info.last_term_option <> amc$terminate) AND ((operation =
            amc$put_next_req) OR (operation = amc$put_direct_req) OR (term_option
            = amc$start)) THEN
        iip$st_put (file_id, open_file_desc_pointer, amc$put_partial_req, NIL, 0,
              byte_address, amc$terminate, status);
        IF NOT status.normal THEN
          EXIT /put_data/;
        IFEND;
      IFEND;

    { Detect context switching and, if needed, blank the screen.
    { The reader should be aware that a recursive call to iip$st_put is made here.

      IF (iiv$previous_mode = iic$screen) AND
            ((open_file_desc_pointer^.terminal_mode = iic$line) OR (file_id.ordinal <>
            iiv$previous_file_id.ordinal)) THEN
        iiv$previous_mode := iic$line;
        IF NOT iiv$previous_blank_flag THEN
          iiv$previous_blank_flag := TRUE;
          saved_attributes := open_file_desc_pointer^.attributes;
          open_file_desc_pointer^.attributes := iiv$previous_connection_attr;
          iip$st_put (file_id, open_file_desc_pointer, amc$put_next_req,
            #LOC (iiv$screen_clear_string.value), iiv$screen_clear_string.size,
            ^put_byte_address, amc$terminate, status);
          open_file_desc_pointer^.attributes := saved_attributes;
        IFEND;
      IFEND;

      iiv$previous_blank_flag := FALSE;
      IF open_file_desc_pointer^.terminal_mode = iic$line THEN
        iiv$previous_mode := iic$line;
      IFEND;
      iiv$previous_operation := operation;
      iiv$previous_file_id := file_id;

      output_sequence_pointer := NIL;
      direct_move := FALSE;
      current_transfer_count := 0;
      iiv$put_info.transfer_count := working_storage_length;
      add_space := FALSE;

    { Transfer data from the user's working storage area to the iiv$output sequence.

      REPEAT

      { Determine the amount of data to move.

        IF working_storage_length > 0 THEN
          move_length := working_storage_length - current_transfer_count;
          IF (move_length + (iiv$put_info.position_in_block - 1)) >
                iic$max_block_size THEN
            move_length := iic$max_block_size - (iiv$put_info.position_in_block
                  - 1);
          IFEND;

          working_storage_array_pointer := working_storage_area; {handle output data as character array. }
          IF (iiv$put_info.position_in_block <> 1) OR (term_option <>
            amc$terminate) THEN

          { Accumulate put partial data in a task local buffer.

            i#move (#LOC (working_storage_array_pointer^ [current_transfer_count]),
                  #LOC (iiv$downline_data_block_ptr^.data [iiv$put_info.position_in_block]),
                  move_length);
          ELSE
            direct_move := TRUE;  { directly move data from wsa to output sequence.}
          IFEND;

        { Update transfer counts.

          current_transfer_count := current_transfer_count + move_length;
          iiv$put_info.position_in_block := iiv$put_info.position_in_block +
                move_length;
          iiv$put_info.transfer_count := iiv$put_info.transfer_count +
                move_length;

        IFEND;  { working_storage_length > 0 }

      { IF the working_storage_length amount of data is buffered AND this is a termination put,
      {    or the put partial buffer is full,
      {    or the output data is to be moved directly from the wsa to the output sequence,
      { THEN move the data to the output sequence.

        IF ((current_transfer_count = working_storage_length) AND (term_option =
              amc$terminate)) OR (iiv$put_info.position_in_block >
              iic$max_block_size) OR direct_move THEN

        /move_data_to_output_sequence/
          WHILE TRUE DO

            iip$set_lock (iiv$downline_queue_lock, osc$nowait, status);
            IF NOT status.normal THEN
              EXIT /put_data/;
            IFEND;
            data_length := iiv$put_info.position_in_block - 1;
            IF data_length <> 0 THEN
              allocate_length := data_length;
            ELSE
              allocate_length := 1;
            IFEND;
            IF open_file_desc_pointer^.attributes.input_editing_mode.value =
                  ifc$normal_edit THEN

        {  Allow for the ascii unit separator (and a blank if the data is zero-length). }

              IF (data_length > 0) THEN
                allocate_length := allocate_length + 1;  { to account for ascii US added later }
                data_length := data_length + 1;
              ELSEIF (data_length = 0) AND (NOT iiv$put_info.term_char_null) THEN
                allocate_length := allocate_length + 1;  { to account for a space added later }
                data_length := data_length + 2;
                add_space := TRUE;
              IFEND;
            IFEND;

            NEXT output_sequence_pointer: [1 .. allocate_length]
                  IN connection_desc_ptr^.output_buffer_entry_loc;

            IF output_sequence_pointer = NIL then
              iip$clear_lock (iiv$downline_queue_lock, status);
              IF NOT status.normal THEN
                EXIT /put_data/;
              IFEND;

              save_last_term_option := iiv$put_info.last_term_option;
              iiv$put_info.last_term_option := amc$terminate;
              iip$st_flush (file_id, open_file_desc_pointer, status);
              iiv$put_info.last_term_option := save_last_term_option;
              IF NOT status.normal THEN
                EXIT /put_data/;
              IFEND;
              CYCLE /move_data_to_output_sequence/;
            IFEND;
            downline_queue_entry_ptr := ^output_sequence_pointer^.block;
            output_sequence_pointer^.length := allocate_length;

          { Form an iit$downline_queue_entry for the output data.

            downline_queue_entry_ptr^.output_info.fill_0 := 0;
            downline_queue_entry_ptr^.output_info.reserved_1 := 0;
            downline_queue_entry_ptr^.output_info.reserved_2 := 0;

            IF (open_file_desc_pointer^.attributes.input_editing_mode.value =
                  ifc$trans_edit) THEN
              downline_queue_entry_ptr^.output_info.formatting_mode := 0;

            { Determine transparency type:  single or multi-message.

              IF (open_file_desc_pointer^.attributes.trans_character_mode.value =
                    ifc$trans_char_terminate) OR
                   (open_file_desc_pointer^.attributes.trans_length_mode.value =
                   ifc$trans_len_terminate) OR
                   (open_file_desc_pointer^.attributes.trans_timeout_mode.value =
                   ifc$trans_timeout_terminate) THEN
                downline_queue_entry_ptr^.transparent_type := ifc$single_message;
              ELSE
                downline_queue_entry_ptr^.transparent_type := ifc$multi_message;
              IFEND;
            ELSE
              IF open_file_desc_pointer^.format_effectors THEN
                downline_queue_entry_ptr^.output_info.formatting_mode := 1;
              ELSE
                downline_queue_entry_ptr^.output_info.formatting_mode := 2;
              IFEND;
            IFEND;  { Determine formatting mode. }

            IF iiv$put_info.term_char_null AND (data_length > 0) THEN
            { A queue entry w/tcn=true should have zero length, else send_output_message will
            { not send it downline--NV0J139, NV0G816.
              downline_queue_entry_ptr^.term_char_null := FALSE;
            ELSE
              downline_queue_entry_ptr^.term_char_null := iiv$put_info.term_char_null;
            IFEND;

            downline_queue_entry_ptr^.term_char_sent := FALSE;
            downline_queue_entry_ptr^.connection_ptr := connection_desc_ptr;
            downline_queue_entry_ptr^.vtp_connection_id := open_file_desc_pointer^.vtp_connection_id;
            downline_queue_entry_ptr^.attributes := open_file_desc_pointer^.attributes;
            downline_queue_entry_ptr^.output_info.secured.suppress_end_line_positioning := FALSE;
            downline_queue_entry_ptr^.output_info.secured.suppress_echoplexing := FALSE;

            IF (iiv$put_info.build_msg_block)
                  AND (NOT connection_desc_ptr^.solicitation_pending) THEN
              downline_queue_entry_ptr^.output_info.partial := FALSE;
              connection_desc_ptr^.solicitation_pending := TRUE;

            { Cause echoplexing and/or cursor positioning to be suppressed with this output.

              IF iiv$suppress_echoplexing THEN
                downline_queue_entry_ptr^.output_info.secured.suppress_echoplexing := TRUE;
                iiv$suppress_echoplexing := FALSE;
              IFEND;
              IF iiv$suppress_cursor_positioning THEN
                downline_queue_entry_ptr^.output_info.secured.suppress_end_line_positioning := TRUE;
                iiv$suppress_cursor_positioning := FALSE;
              IFEND;
            ELSE
              downline_queue_entry_ptr^.output_info.partial := TRUE;
              IF NOT downline_queue_entry_ptr^.term_char_null THEN
                connection_desc_ptr^.solicitation_pending := FALSE;
              IFEND;
            IFEND;

          { Move the data from either the task downline block or the user's working
          { storage area to the downline_queue_entry.

            IF data_length > 0 THEN
              IF NOT direct_move THEN
                i#move (#LOC (iiv$downline_data_block_ptr^.data [1]), #LOC
                      (downline_queue_entry_ptr^.data [1]), data_length);
              ELSE
                i#move (#LOC (working_storage_array_pointer^ [current_transfer_count-move_length]),
                      #LOC (downline_queue_entry_ptr^.data [1]), data_length);
              IFEND;
            IFEND;

            IF open_file_desc_pointer^.attributes.input_editing_mode.value = ifc$normal_edit THEN

            { Add an ascii unit separator to non-transparent output lines.

              IF data_length > 0 THEN
                downline_queue_entry_ptr^.data [data_length] := iic$ascii_us;
                IF add_space THEN

                { Add a SPACE to avoid problem of double ascii-US characters (NV0G353).

                  downline_queue_entry_ptr^.data [data_length - 1] := ' ';
                  add_space := FALSE;
                IFEND;
              IFEND;
            ELSE { then it must be transparent }
              IF data_length = 0 THEN
                { turn on term_char_null so no output will be sent to network.
                downline_queue_entry_ptr^.term_char_null := TRUE;
              IFEND;
            IFEND;

            connection_desc_ptr^.downline_queue_count := connection_desc_ptr^.downline_queue_count +
                  allocate_length;
            output_sequence_pointer := NIL;
            iip$clear_lock (iiv$downline_queue_lock, local_status);
            EXIT /move_data_to_output_sequence/;

          WHILEND /move_data_to_output_sequence/;

          iiv$put_info.position_in_block := 1;

        IFEND;  { Check to see if there is data to be moved to output sequence. }

      UNTIL current_transfer_count = working_storage_length;

    { Save access information.

      open_file_desc_pointer^.last_get_put_operation := operation;
      open_file_desc_pointer^.last_access_operation := operation;
      open_file_desc_pointer^.previous_record_length := iiv$put_info.transfer_count;

      iiv$put_info.last_term_option := term_option;

      IF term_option = amc$terminate THEN
        iiv$put_info.transfer_count := 0;
      IFEND;

    END /put_data/;

  PROCEND iip$st_put;

MODEND iim$st_put;
