*copyc OSD$DEFAULT_PRAGMATS
MODULE iim$put;
?? TITLE := 'MODULE iim$put' ??

?? PUSH (LISTEXT := ON) ??
*copyc AMT$FILE_BYTE_ADDRESS
*copyc AMT$FILE_IDENTIFIER
*copyc amc$fap_request_codes
*copyc AMT$TERM_OPTION
*copyc AME$PUT_VALIDATION_ERRORS
*copyc AMT$WORKING_STORAGE_LENGTH
*copyc amp$put_next
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc IIK$KEYPOINTS
*copyc IIT$INTERACTIVE_SIGNAL_TYPE
*copyc IIP$BUILD_DATA_MSG_SKELETON
*copyc iip$build_term_char_values
*copyc IIP$CLEAR_LOCK
*copyc IIP$FLUSH
*copyc IIV$INTERACTIVE_TERMINATED
*copyc IIP$REPORT_STATUS_ERROR
*copyc IIP$SET_LOCK
*copyc IIV$INT_TASK_OPEN_FILE_COUNT
*copyc IIV$CONNECTION_DESC_PTR
*copyc IIP$UPDATE_OPEN_DESC_ATTRIBUTES
*copyc I#MOVE
*copyc I#COMPARE
*copyc OST$STATUS
*copyc OSP$TEST_SIG_LOCK
*copyc IIP$SEND_OUTPUT_MESSAGE
*copyc pmp$task_debug_mode_on
*copyc iiv$output
*copyc osp$establish_condition_handler
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause
*copyc pmp$log
?? POP ??

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

  PROCEDURE [XDCL, #GATE] iip$put (file_id: amt$file_identifier;
        open_file_desc_pointer: ^iit$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
      saved_attributes: iit$connection_attributes,
      saved_build_msg: boolean,
      saved_effectors: boolean,
      save_last_term_option: amt$term_option,
      direct_move,
      wait,
      flush_output: boolean,
      iiv$last_output_time,
      iiv$output_option: [XREF] integer,
      po: ^iit$output,
      put_byte_address: amt$file_byte_address,
      current_transfer_count: amt$transfer_count,
      ol,
      move_length: 0..0ffffffffffff(16),
      ps1,
      ps2: ^string (15),
      working_storage_array_pointer: ^array [0 .. iic$max_record_length] of
        char,
      downline_queue_entry_descriptor: iit$queue_entry_descriptor,
      c180_downline_queue_entry_ptr: ^iit$downline_queue_entry,
      c180_downline_text_length: iit$text_length,
      ls: ost$signature_lock_status,
      temp: iit$field_value,
      local_status: ost$status;

    PROCEDURE handle_condition (cond: pmt$condition;
          cd: ^pmt$condition_information;
          sa: ^ost$stack_frame_save_area;
      VAR ch_status: ost$status);

      ch_status.normal := TRUE;

      IF (cond.selector = pmc$user_defined_condition) AND
            (cond.user_condition_name = 'OSC$JOB_RECOVERY') THEN
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        RETURN;
      IFEND;

      IF cond.selector <> ifc$interactive_condition THEN
        osp$set_status_from_condition ('IF', cond, sa, status, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
        IFEND;
        pmp$log ('Possible invalid user parameter detected by interactive', local_status);
        osp$test_sig_lock (iiv$downline_queue_lock, ls);
        IF ls = osc$sls_locked_by_current_task THEN
          IF po <> NIL THEN
            RESET iiv$output TO po;
          IFEND;
          iip$clear_lock (iiv$downline_queue_lock, local_status);
        IFEND;
        EXIT iip$put;
      ELSE

{ Clear the lock for interactive conditions

        osp$test_sig_lock (iiv$downline_queue_lock, ls);
        IF ls = osc$sls_locked_by_current_task THEN
          IF po <> NIL THEN
            RESET iiv$output TO po;
          IFEND;
          iip$clear_lock (iiv$downline_queue_lock, local_status);
        IFEND;
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);

{ If we get control back, pretend the put request was completed okay and exit.

        status.normal := TRUE;
        EXIT iip$put;
      IFEND;
    PROCEND handle_condition;

?? EJECT ??



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

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

      status.normal := TRUE;
      RETURN;
    IFEND;
    status.normal := TRUE;

{ Return an error if at end of record 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);
      RETURN;
    IFEND;

{ Terminate the previous record if at mid-record and the operation
{ is a full put or a put partial start.

    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$put (file_id, open_file_desc_pointer, amc$put_partial_req, NIL, 0,
            byte_address, amc$terminate, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

  { Detect context switching and, if needed, blank the screen.

    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;
        saved_build_msg := iiv$put_info.build_msg_block;
        saved_effectors := open_file_desc_pointer^.format_effectors;
        open_file_desc_pointer^.attributes := iiv$previous_connection_attr;
        open_file_desc_pointer^.format_effectors := FALSE;
        iiv$put_info.build_msg_block := FALSE;
        iip$build_term_char_values (open_file_desc_pointer);
        iip$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;
        open_file_desc_pointer^.format_effectors := saved_effectors;
        iiv$put_info.build_msg_block := saved_build_msg;
        iip$build_term_char_values (open_file_desc_pointer);
      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;

    po := NIL;
    direct_move := FALSE;
    flush_output := FALSE;
    current_transfer_count := 0;
    iiv$put_info.transfer_count := working_storage_length;
    osp$establish_condition_handler (^handle_condition, FALSE);

{ Transfer data from the user's working storage area to the downline queue.

  /transfer_data_to_downline_queue/
    WHILE TRUE DO

{ 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 - 9 THEN
          move_length := (iic$max_block_size - 9) - (iiv$put_info.
                position_in_block - 1);
        IFEND;

{ Move the data from the working storage area to a task local downline block.

        working_storage_array_pointer := working_storage_area;
        IF (iiv$put_info.position_in_block <> 1) OR (term_option <>
          amc$terminate) THEN
          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;
        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;

{ Create a new downline queue entry.

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

      /queue_downline_block/
        WHILE TRUE DO

          iip$set_lock (iiv$downline_queue_lock, osc$nowait, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        c180_downline_text_length := iiv$put_info.position_in_block - 1;
        IF c180_downline_text_length <> 0 THEN
          ol := c180_downline_text_length;
        ELSE
          ol := 1;
        IFEND;

        NEXT po: [1 .. ol] in iiv$output;
        IF po = NIL then
            iip$clear_lock (iiv$downline_queue_lock, local_status);

            save_last_term_option := iiv$put_info.last_term_option;
            iiv$put_info.last_term_option := amc$terminate;
            iip$flush (file_id, open_file_desc_pointer, status);
            iiv$put_info.last_term_option := save_last_term_option;
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            CYCLE /queue_downline_block/;
        IFEND;

        c180_downline_queue_entry_ptr := ^po^.block;
        po^.length := ol;

        iip$build_data_msg_skeleton (^c180_downline_queue_entry_ptr^.message,
              c180_downline_text_length);

        IF open_file_desc_pointer^.format_effectors THEN
          c180_downline_queue_entry_ptr^.message.header.no_format_effectors := false;
        ELSE
          c180_downline_queue_entry_ptr^.message.header.no_format_effectors := true;
        IFEND;

        c180_downline_queue_entry_ptr^.message.header.transparent := (open_file_desc_pointer^.
              attributes.input_editing_mode.value = ifc$trans_edit);

        c180_downline_queue_entry_ptr^.term_char_null := iiv$put_info.
              term_char_null;
        c180_downline_queue_entry_ptr^.connection_ptr :=
              open_file_desc_pointer^.connection_desc_pointer;
        c180_downline_queue_entry_ptr^.repeated_output := FALSE;

        IF iiv$put_info.build_msg_block THEN
          c180_downline_queue_entry_ptr^.message.header.block_type :=
                iic$last_block;
          c180_downline_queue_entry_ptr^.message.header.transparent := FALSE;
        IFEND;

{ Update the terminal attributes of the open file description if they might
{ have changed.

        IF open_file_desc_pointer^.attributes_cycle <> open_file_desc_pointer^.
              connection_desc_pointer^.attributes_cycle THEN
          iip$update_open_desc_attributes (file_id, open_file_desc_pointer,
                operation, status);
          IF NOT status.normal THEN
            iip$clear_lock (iiv$downline_queue_lock, local_status);
            RETURN;
          IFEND;
        IFEND;
        c180_downline_queue_entry_ptr^.term_char_changed := FALSE;
        c180_downline_queue_entry_ptr^.term_char_sent := FALSE;

{ Update the connection description terminal characteristics values if
{ they have changed.

        iip$set_lock (open_file_desc_pointer^.connection_desc_pointer^.lock,
              osc$wait, local_status);

{ Save the transparency indicator for this instance-of-open.  It may be overwritten
{ in the upcoming ploy to avoid sending transparent attribute changes.

        temp := open_file_desc_pointer^.term_char_values [ iic$key_trans_input_mode ];

{ This IF statement was added to fix PSR NV02502.

        IF (NOT iiv$put_info.term_char_null) THEN
          open_file_desc_pointer^.term_char_values [ iic$key_trans_input_mode ] :=
            open_file_desc_pointer^.connection_desc_pointer^.
              term_char_values [ iic$key_trans_input_mode ];
        ELSEIF (open_file_desc_pointer^.attributes.input_editing_mode.value =
             ifc$trans_edit) THEN
          open_file_desc_pointer^.term_char_values [ iic$key_trans_input_mode ] := 1;
        IFEND;

        ps1 := #LOC (open_file_desc_pointer^.term_char_values);
        ps2 := #LOC (open_file_desc_pointer^.connection_desc_pointer^.
              term_char_values);
        IF (i#compare (ps1^, ps2^) <> 0) OR
              ((open_file_desc_pointer^.attributes.trans_character_mode.value =
               ifc$trans_char_terminate) AND (iiv$put_info.term_char_null)) THEN
          c180_downline_queue_entry_ptr^.term_char_changed := TRUE;
          c180_downline_queue_entry_ptr^.term_char_values :=
                open_file_desc_pointer^.term_char_values;
          c180_downline_queue_entry_ptr^.transparent_character_selected :=
                (open_file_desc_pointer^.attributes.
                trans_character_mode.value <> ifc$no_trans_char);
          c180_downline_queue_entry_ptr^.transparent_count_selected :=
                (open_file_desc_pointer^.attributes.
                trans_length_mode.value <> ifc$no_trans_len);
          c180_downline_queue_entry_ptr^.transparent_time_out_selected :=
                (open_file_desc_pointer^.attributes.
                trans_timeout_mode.value <> ifc$no_trans_timeout);
          open_file_desc_pointer^.connection_desc_pointer^.term_char_values :=
                open_file_desc_pointer^.term_char_values;
        IFEND;

{ Restore the transparency indicator.

        open_file_desc_pointer^.term_char_values [ iic$key_trans_input_mode ] := temp;

        iip$clear_lock (open_file_desc_pointer^.connection_desc_pointer^.lock,
              local_status);

{ Move the data from the task downline block to the downline queue entry.

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

{ Add the downline queue entry to the downline queue.

          IF ((iiv$output_option <> 0) AND (iiv$output_option <
              (#free_running_clock (0) - iiv$last_output_time))) THEN
            flush_output := TRUE;
          IFEND;
          iiv$downline_queue_count := iiv$downline_queue_count + ol;
          po := NIL;
          iip$clear_lock (iiv$downline_queue_lock, local_status);
          EXIT /queue_downline_block/;

        WHILEND /queue_downline_block/;

        iiv$put_info.position_in_block := 1;

      IFEND;

      IF current_transfer_count = working_storage_length THEN
        EXIT /transfer_data_to_downline_queue/;
      IFEND;

    WHILEND /transfer_data_to_downline_queue/;

{ Save access information.

    IF flush_output THEN
      iip$send_output_message (FALSE, local_status);
    IFEND;
    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;


  PROCEND iip$put;

MODEND iim$put;
