?? RIGHT := 110 ??
MODULE ifm$st_fap_control;
?? TITLE := 'MODULE ifm$st_fap_control' ??
*copyc AME$DEVICE_CLASS_VALIDATION
*copyc AME$OPEN_VALIDATION_ERRORS
*copyc AMP$ACCESS_METHOD
*copyc AMP$FETCH_FAP_POINTER
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc AMP$STORE_FAP_POINTER
*copyc AMT$FAP_POINTER
*copyc AMT$SKIP_OPTION
*copyc AMT$TERM_OPTION
*copyc bat$task_file_table
*copyc bav$last_tft_entry
*copyc bav$task_file_table
*copyc IFP$MARK_ATTRIBUTES_CHANGE
*copyc ife$error_codes
*copyc IIP$ALLOCATE_QUEUE_ENTRY
*copyc IIP$CHECK_FOR_CONDITION
*copyc IIP$CHECK_IF_STATUS
*copyc IIP$FETCH_ACCESS_INFORMATION
*copyc IIP$FETCH_TERM_CONN_ATTRIBUTES
*copyc IIP$FREE_QUEUE_ENTRY
*copyc IIP$REPORT_STATUS_ERROR
*copyc iip$search_connection_desc
*copyc IIP$STORE_TERM_CONN_ATTRIBUTES
*copyc IIP$ST_ALLOCATE_QUEUE_ENTRY
*copyc IIP$ST_CLOSE
*copyc IIP$ST_FETCH_ACCESS_INFORMATION
*copyc IIP$ST_FLUSH
*copyc IIP$ST_GET
*copyc IIP$ST_OPEN
*copyc IIP$ST_PUT
*copyc IIP$UPDATE_OPEN_DESC_ATTRIBUTES
*copyc jmp$handle_ts_io_req_failure
*copyc jmp$ts_io_request_valid
*copyc jmv$connection_acquired
*copyc IIV$CONNECTION_DESC_PTR
*copyc IIV$INTERACTIVE_TERMINATED
*copyc IIV$INT_TASK_OPEN_FILE_COUNT
*copyc iiv$interactive_terminated
*copyc jmv$terminal_io_disabled
*copyc osp$set_status_abnormal
*copyc OSS$TASK_PRIVATE
*copyc OST$STACK_FRAME_SAVE_AREA
*copyc OST$STATUS
*copyc OSV$TASK_PRIVATE_HEAP
*copyc PMT$CONDITION_INFORMATION

?? NEWTITLE := 'PROCEDURE ifp$st_fap_control_ring_3', EJECT ??

  PROCEDURE [XDCL, #GATE] ifp$st_fap_control_ring_3 (file_id: amt$file_identifier;
        call_block: amt$call_block;
        layer_number: amt$fap_layer_number;
    VAR callers_status: ost$status);

    VAR
      connection_desc_ptr: ^iit$connection_description,
      file_id_is_valid: boolean,
      file_instance: ^bat$task_file_entry,
      open_file_entry_descriptor: iit$queue_entry_descriptor,
      st_open_file_entry_descriptor: iit$st_queue_entry_descriptor,
      open_file_dsc_pointer: ^iit$open_file_description,
      st_open_file_dsc_pointer: ^iit$st_open_file_description,
      fetch_attributes_pointer: ^amt$fetch_attributes,
      file_identifier: amt$file_identifier,
      i: integer,
      pc: ^cell,
      sell: cell,
      status: ost$status,
      local_status: ost$status;

    status.normal := TRUE;
    open_file_dsc_pointer := NIL;

    /status_change_block/
    BEGIN
    IF call_block.operation = amc$open_req THEN

{ Detect improper access level ( physical access or segment access ).

      IF call_block.open.access_level = amc$physical THEN
        amp$set_file_instance_abnormal (file_id,
              ame$not_physical_access_device, call_block.operation, 'TERMINAL',
              callers_status);
        RETURN;
      IFEND;

      IF call_block.open.access_level = amc$segment THEN
        amp$set_file_instance_abnormal (file_id, ame$not_virtual_memory_device,
              call_block.operation, 'TERMINAL', callers_status);
        RETURN;
      IFEND;
        IF NOT jmp$ts_io_request_valid () THEN
          IF jmv$connection_acquired THEN
            jmp$handle_ts_io_req_failure (status);
            IF NOT status.normal THEN
              callers_status := status;
              RETURN;
            IFEND;
          IFEND;
        IFEND;

{ Build open file description entry and store the pointer.

        iip$st_allocate_queue_entry (iic$open_file_description,
              st_open_file_entry_descriptor, status);
        IF NOT status.normal THEN
          EXIT /status_change_block/;
        IFEND;

        st_open_file_dsc_pointer := st_open_file_entry_descriptor.
              open_file_description_ptr;

        file_identifier := file_id;
*copy bai$validate_file_identifier
        IF file_id_is_valid AND
          (file_instance <> NIL) THEN
          IF file_instance^.device_class =
            rmc$terminal_device THEN
            file_instance^.st_open_file_dsc_pointer :=
            st_open_file_dsc_pointer;
          ELSE
            osp$set_status_abnormal (ifc$interactive_facility_id,
              ife$file_name_not_terminal,
              file_instance^.local_file_name,status);
          IFEND;
        ELSE
          osp$set_status_abnormal (ifc$interactive_facility_id,
            ife$file_name_not_terminal,
            'NON_TERMINAL_FILE',status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /status_change_block/;
        IFEND;

        iip$st_open (file_id, st_open_file_dsc_pointer, call_block.open.
              local_file_name, layer_number, status);

      IF NOT status.normal THEN
        EXIT /status_change_block/;
      IFEND;

      amp$access_method (file_id, call_block, layer_number, status);

    ELSEIF call_block.operation = amc$close_req THEN
        file_identifier := file_id;
*copy bai$validate_file_identifier
*copy iii$fetch_st_open_file_desc_ptr
        IF NOT status.normal THEN
          EXIT /status_change_block/;
        IFEND;

        iip$st_close (file_id, st_open_file_dsc_pointer, status);

      amp$access_method (file_id, call_block, layer_number, status);
    ELSE

{ all reqs other than open/close respect if condition state

        IF NOT jmp$ts_io_request_valid () THEN
          IF (NOT jmv$connection_acquired) AND (
             (call_block.operation = amc$put_next_req) OR
             (call_block.operation = amc$put_partial_req) OR
             (call_block.operation = amc$fetch_req) OR
             (call_block.operation = amc$put_direct_req) OR
             (call_block.operation = amc$flush_req)) THEN
            {Ignore request
            status.normal := TRUE;
            EXIT /status_change_block/;
          ELSE
            jmp$handle_ts_io_req_failure (status);
            IF NOT status.normal THEN
              EXIT /status_change_block/;
            IFEND;
          IFEND;
        IFEND;

{ Get pointer to open file description which was stored on the open.

        file_identifier := file_id;
*copy bai$validate_file_identifier
*copy iii$fetch_st_open_file_desc_ptr
        IF NOT status.normal THEN
          EXIT /status_change_block/;
        IFEND;
        iip$search_connection_desc (st_open_file_dsc_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 /status_change_block/;
        IFEND;

      CASE call_block.operation OF

      = amc$get_next_req =

        pc := call_block.getn.working_storage_area;
        sell := pc^;
        pc^ := sell;
        pc := call_block.getn.transfer_count;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getn.byte_address;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getn.file_position;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;

          iip$st_get (file_id, st_open_file_dsc_pointer, call_block.operation,
                call_block.getn.working_storage_area, call_block.getn.
                working_storage_length, NIL, call_block.getn.transfer_count,
                call_block.getn.byte_address, call_block.getn.file_position,
                amc$skip_to_eor, status);

      = amc$get_partial_req =

        pc := call_block.getp.working_storage_area;
        sell := pc^;
        pc^ := sell;
        pc := call_block.getp.record_length;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getp.transfer_count;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getp.byte_address;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getp.file_position;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;

          iip$st_get (file_id, st_open_file_dsc_pointer, call_block.operation,
                call_block.getp.working_storage_area, call_block.getp.
                working_storage_length, call_block.getp.record_length,
                call_block.getp.transfer_count, call_block.getp.byte_address,
                call_block.getp.file_position, call_block.getp.skip_option,
                status);

      = amc$get_direct_req =

        pc := call_block.getd.working_storage_area;
        sell := pc^;
        pc^ := sell;
        pc := call_block.getd.transfer_count;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;
        pc := call_block.getd.file_position;
        IF pc <> NIL THEN
          sell := pc^;
          pc^ := sell;
        IFEND;

          iip$st_get (file_id, st_open_file_dsc_pointer, call_block.operation,
                call_block.getd.working_storage_area, call_block.getd.
                working_storage_length, NIL, call_block.getd.transfer_count, NIL,
                call_block.getd.file_position, amc$skip_to_eor, status);

      = amc$put_next_req =

        IF (call_block.putn.working_storage_length >= 0) AND (call_block.putn.working_storage_length <=
               UPPERVALUE (amt$working_storage_length)) AND
               ((call_block.putn.working_storage_area <> NIL) OR
                 ((call_block.putn.working_storage_area = NIL) AND
                 (call_block.putn.working_storage_length = 0))) THEN
            iip$st_put (file_id, st_open_file_dsc_pointer, call_block.operation,
                  call_block.putn.working_storage_area, call_block.putn.
                  working_storage_length, call_block.putn.byte_address,
                  amc$terminate, status);

        ELSE
          IF call_block.putn.working_storage_area = NIL THEN
            osp$set_status_abnormal (ifc$interactive_facility_id, ife$wsa_is_nil, '', status);
          ELSE
            osp$set_status_abnormal (ifc$interactive_facility_id, ife$wsl_out_of_range, '', status);
          IFEND;
        IFEND;

      = amc$put_partial_req =

          iip$st_put (file_id, st_open_file_dsc_pointer, call_block.operation,
                call_block.putp.working_storage_area, call_block.putp.
                working_storage_length, call_block.putp.byte_address, call_block.
                putp.term_option, status);

      = amc$put_direct_req =

          iip$st_put (file_id, st_open_file_dsc_pointer, call_block.operation,
                call_block.putd.working_storage_area, call_block.putd.
                working_storage_length, NIL, amc$terminate, status);

      = amc$flush_req =

          iip$st_flush (file_id, st_open_file_dsc_pointer, status);

      = amc$fetch_access_information_rq =

        pc := call_block.fai.access_information;
        sell := pc^;
        pc^ := sell;

          iip$st_fetch_access_information (file_id, st_open_file_dsc_pointer,
                call_block.fai.access_information, status);

      = ifc$fetch_terminal_req =

        pc := call_block.fetch_terminal.terminal_attributes;
        sell := pc^;
        pc^ := sell;

          iip$fetch_term_conn_attributes (file_id, st_open_file_dsc_pointer, call_block.
                fetch_terminal.terminal_attributes^, status);

      = ifc$store_terminal_req =

        pc := call_block.store_terminal.terminal_attributes;
        sell := pc^;

          iip$store_term_conn_attributes (file_id, st_open_file_dsc_pointer, call_block.
                store_terminal.terminal_attributes, status);

      = amc$seek_direct_req, amc$skip_req, amc$rewind_req, amc$replace_req,
            amc$write_end_partition_req =

        status.normal := TRUE;

      = amc$fetch_req =

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


        amp$access_method (file_id, call_block, layer_number, status);

{ Return the interactive values for page_length and page_width if they have
{ not been specified by BAM requests.

        IF status.normal THEN

          fetch_attributes_pointer := call_block.fetch.file_attributes;

        /fix_page_length_and_page_width/
          FOR i := LOWERBOUND (fetch_attributes_pointer^) TO UPPERBOUND
                (fetch_attributes_pointer^) DO
            IF ((fetch_attributes_pointer^ [i].key = amc$page_length) AND
                  ((fetch_attributes_pointer^ [i].source =
                  amc$undefined_attribute) OR (fetch_attributes_pointer^ [i].
                  source = amc$access_method_default))) THEN

                IF connection_desc_ptr <> NIL THEN
                  IF connection_desc_ptr^.page_length = 0 THEN
                    fetch_attributes_pointer^ [i].page_length := UPPERVALUE (amt$page_length);
                  ELSE
                    fetch_attributes_pointer^ [i].page_length := connection_desc_ptr^.page_length;
                  IFEND;
                IFEND;

              CYCLE /fix_page_length_and_page_width/;

            IFEND;
            IF ((fetch_attributes_pointer^ [i].key = amc$page_width) AND
                  ((fetch_attributes_pointer^ [i].source =
                  amc$undefined_attribute) OR (fetch_attributes_pointer^ [i].
                  source = amc$access_method_default))) THEN

                IF connection_desc_ptr <> NIL THEN
                  IF connection_desc_ptr^.page_width = 0 THEN
                    fetch_attributes_pointer^ [i].page_width := amc$max_page_width;
                  ELSE
                    fetch_attributes_pointer^ [i].page_width := connection_desc_ptr^.page_width;
                  IFEND;
                IFEND;

              CYCLE /fix_page_length_and_page_width/;

            IFEND;
          FOREND /fix_page_length_and_page_width/;

        IFEND;

      = amc$store_req =

        pc := call_block.store.file_attributes;
        sell := pc^;

        amp$access_method (file_id, call_block, layer_number, status);

      ELSE

{ The operation is improper for a terminal device.

        amp$set_file_instance_abnormal (file_id, ame$improper_device_class,
              call_block.operation, 'terminal', status);
      CASEND;

    IFEND;

    END /status_change_block/;

    IF status.normal THEN
      callers_status.normal := TRUE;
      callers_status.condition := 0;
    ELSE
      CASE call_block.operation OF
      = amc$put_next_req, amc$put_partial_req, amc$put_direct_req, amc$flush_req =
        IF (status.condition = jme$job_is_in_termination) OR (status.condition = jme$task_is_in_termination)
             OR jmv$terminal_io_disabled THEN
          status.normal := TRUE;
          status.condition := 0;
        IFEND;
      ELSE
      CASEND;

      callers_status := status;
    IFEND;

{ Save access information for this request.

    IF open_file_dsc_pointer <> NIL THEN

      IF callers_status.normal THEN
        open_file_dsc_pointer^.error_status := 0;
      ELSE
        open_file_dsc_pointer^.error_status := callers_status.condition;
      IFEND;

      IF (call_block.operation <> amc$fetch_access_information_rq) AND
        (call_block.operation <> amc$fetch_req) THEN
        open_file_dsc_pointer^.last_access_operation := call_block.operation;
      IFEND;

    IFEND;

  PROCEND ifp$st_fap_control_ring_3;

MODEND ifm$st_fap_control;
