*copyc OSD$DEFAULT_PRAGMATS
MODULE icm$fap_control;
?? TITLE := ' MODULE icm$fap_control' ??
?? PUSH (LISTEXT := ON) ??
*copyc AMP$ACCESS_METHOD
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc AMT$FAP_POINTER
*copyc AMP$FETCH_FAP_POINTER
*copyc AMP$STORE_FAP_POINTER
*copyc AME$FAP_VALIDATION_ERRORS
*copyc ICE$ERROR_CODES
*copyc ICF$OPEN_FILE_DESCRIPTOR
*copyc ICT$PARTNER_MESSAGES
*copyc ICP$CLOSE
*copyc ICP$FETCH_ACCESS_INFO
*copyc ICP$FLUSH
*copyc ICP$GET
*copyc ICP$OPEN
*copyc ICP$PUT
*copyc ICV$OPEN_FILE_COUNT_LOCK
*copyc ICP$WRITE_END_PARTITION
*copyc OST$STATUS
*copyc OSP$CLEAR_JOB_SIGNATURE_LOCK
*copyc OSP$SET_JOB_SIGNATURE_LOCK
*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSV$TASK_PRIVATE_HEAP
*copyc PMP$GET_170_OS_TYPE
*copyc PMP$EXIT
?? POP ??
?? NEWTITLE := 'PROCEDURE [XDCL, #GATE] icp$fap_control' ??

{  ICP$FAP_CONTROL
{
{     The purpose of this procedure is to do the initial FAP
{  processing of amp$ requests on a link file.  Additional routines
{  are called as necessary to complete the processing.

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

    VAR
      icf_file: ^icf_open_file_descriptor,
      os_type: ost$170_os_type,
      stat: ost$status;

    stat.normal := TRUE;
    pmp$get_170_os_type (os_type, status);
    IF status.normal THEN
      IF os_type = osc$ot7_none THEN
        osp$set_status_abnormal (icc$interstate_communication_id,
              ice$no_partner_exists, '', status);
        RETURN;
      IFEND;
    IFEND;
    IF call_block.operation = amc$open_req THEN
      ALLOCATE icf_file IN osv$task_private_heap^;
      amp$store_fap_pointer (file_id, layer_number, icf_file, stat);
      IF NOT stat.normal THEN
        pmp$exit (stat);
      IFEND;
      icf_file^.file_id := file_id;
      icp$open (icf_file, call_block.operation, call_block.open.access_level,
            stat);
      IF stat.normal THEN
        amp$access_method (file_id, call_block, layer_number, stat);
      IFEND;
    ELSE
      amp$fetch_fap_pointer (file_id, layer_number, icf_file, stat);
      IF NOT stat.normal THEN
        pmp$exit (stat);
      IFEND;
      CASE call_block.operation OF

      = amc$fetch_req =
        amp$access_method (file_id, call_block, layer_number, stat);

      = amc$fetch_access_information_rq =
        icp$fetch_access_info (icf_file, call_block.operation,
              call_block.fai.access_information, stat);

      = amc$rewind_req =
        icf_file^.position := amc$boi;

      = amc$seek_direct_req, amc$skip_req =

      = amc$write_tape_mark_req, amc$get_segment_pointer_req,
            amc$set_segment_eoi_req, amc$set_segment_position_req,
            amc$replace_req =
        amp$set_file_instance_abnormal (file_id, ame$improper_fap_operation,
              call_block.operation, '', stat);

      = amc$close_req =
        osp$set_job_signature_lock (icv$open_file_count_lock);
        IF icv$open_file_count > 0 THEN
          icv$open_file_count := icv$open_file_count - 1;
        IFEND;
        osp$clear_job_signature_lock (icv$open_file_count_lock);
        IF ((icf_file^.last_fap_op <> amc$open_req) OR
              ((icf_file^.last_fap_op = amc$open_req) AND
              (icf_file^.last_status = 0))) THEN
          icp$close (icf_file, call_block.operation, stat);
        IFEND;
        IF icf_file^.buff <> NIL THEN
          FREE icf_file^.buff IN osv$task_private_heap^;
        IFEND;
        FREE icf_file IN osv$task_private_heap^;
        amp$access_method (file_id, call_block, layer_number, stat);

      = amc$flush_req =
        icp$flush (icf_file, call_block.operation, stat);

      = amc$get_direct_req =
        icp$get (icf_file, call_block.operation,
              call_block.getd.working_storage_area,
              call_block.getd.working_storage_length,
              call_block.getd.transfer_count, amc$skip_to_eor, stat);
        call_block.getd.file_position^ := icf_file^.position;

      = amc$get_next_req =
        icp$get (icf_file, call_block.operation,
              call_block.getn.working_storage_area,
              call_block.getn.working_storage_length,
              call_block.getn.transfer_count, amc$skip_to_eor, stat);
        call_block.getn.file_position^ := icf_file^.position;

      = amc$get_partial_req =
        icp$get (icf_file, call_block.operation,
              call_block.getp.working_storage_area,
              call_block.getp.working_storage_length,
              call_block.getp.transfer_count, call_block.getp.skip_option,
              stat);
        call_block.getp.file_position^ := icf_file^.position;
        call_block.getp.record_length^ := icf_file^.record_length;

      = amc$put_direct_req =
        icp$put (icf_file, call_block.operation,
              call_block.putd.working_storage_area,
              call_block.putd.working_storage_length, amc$start, stat);

      = amc$put_next_req =
        icp$put (icf_file, call_block.operation,
              call_block.putn.working_storage_area,
              call_block.putn.working_storage_length, amc$start, stat);

      = amc$put_partial_req =
        icp$put (icf_file, call_block.operation,
              call_block.putp.working_storage_area,
              call_block.putp.working_storage_length,
              call_block.putp.term_option, stat);

      = amc$write_end_partition_req =
        icp$write_end_partition (icf_file, call_block.operation, stat);

      ELSE
        amp$access_method (file_id, call_block, layer_number, stat);
      CASEND;
    IFEND;
    IF (call_block.operation <> amc$close_req) AND
          (call_block.operation <> amc$fetch_access_information_rq) THEN
      icf_file^.last_fap_op := call_block.operation;
      IF stat.normal THEN
        icf_file^.last_status := 0;
      ELSE
        icf_file^.last_status := stat.condition;
      IFEND;
    IFEND;
    status := stat;
  PROCEND icp$fap_control;
MODEND icm$fap_control;
