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

?? PUSH (LISTEXT := ON) ??
*copyc AMT$FILE_IDENTIFIER
*copyc AMP$CLOSE
*copyc ife$error_codes
*copyc IIV$CONNECTION_DESC_PTR
*copyc IIP$CLEAR_LOCK
*copyc IIP$ST_FREE_QUEUE_ENTRY
*copyc IIV$INTERACTIVE_TERMINATED
*copyc iip$search_connection_desc
*copyc IIP$ST_PUT
*copyc iip$st_flush
*copyc IIP$SET_LOCK
*copyc iip$vt_terminate_connection
*copyc IIV$INT_TASK_OPEN_FILE_COUNT
*copyc osp$set_status_abnormal
*copyc OST$STATUS
*copyc iip$vt_close
*copyc osv$job_pageable_heap
*copyc jmv$connection_acquired
?? POP ??

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

  PROCEDURE [XDCL, #GATE] iip$st_close (file_id: amt$file_identifier;
    VAR open_file_desc_pointer: ^iit$st_open_file_description;
    VAR status: ost$status);

    VAR
      connection_desc_ptr: ^iit$connection_description,
      conn_desc_entry_descriptor: iit$st_queue_entry_descriptor,
      local_status: ost$status,
      open_file_entry_descriptor: iit$st_queue_entry_descriptor,
      temp_connection_desc_ptr: ^iit$connection_description;

      status.normal := TRUE;

{ Return with normal status if the file is not open because BAM must close file.

      IF open_file_desc_pointer = NIL THEN
        RETURN;
      IFEND;

{ Close the prompt file if the system has opened it.

    IF (open_file_desc_pointer^.attributes.prompt_file_identifier.value.ordinal
          <> 0) AND (open_file_desc_pointer^.attributes.prompt_file_identifier.
          source = ifc$os_default) THEN
      amp$close (open_file_desc_pointer^.attributes.prompt_file_identifier.value, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;

    IFEND;

{ Decrement task open file count.

    IF iiv$int_task_open_file_count > 0 THEN
    iiv$int_task_open_file_count := iiv$int_task_open_file_count - 1;
    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);
      RETURN;
    IFEND;

{ Terminate the previous record if at mid_record.

    IF iiv$put_info.last_term_option <> amc$terminate THEN
      iip$st_put (file_id, open_file_desc_pointer, amc$put_partial_req, NIL, 0,
        NIL, amc$terminate, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;

    IFEND;

    IF jmv$connection_acquired THEN
    iip$st_flush (file_id, open_file_desc_pointer, status);
    IF status.normal = FALSE THEN
    return;
    IFEND;
    IFEND;


  { Call iip$vt_close to close the session-layer file's instance-of-open.

    iip$vt_close (open_file_desc_pointer^.vtp_file_id, status);
    IF status.normal = FALSE THEN
    return;
    IFEND;


  { Determine if the connection description is now orphaned and should be freed.

    iip$set_lock (iiv$connection_desc_lock, osc$wait, status);

    IF status.normal = FALSE THEN
    return;
    IFEND;

    connection_desc_ptr^.open_local_file_count := connection_desc_ptr^.open_local_file_count - 1;
    IF connection_desc_ptr^.open_local_file_count <= 0 THEN
      { decrement count of connection descriptors, and unlink it }
      iiv$connection_desc_count := PRED (iiv$connection_desc_count);
      IF connection_desc_ptr = iiv$connection_desc_ptr THEN
        iiv$connection_desc_ptr := iiv$connection_desc_ptr^.next_connection_desc_ptr;
      ELSE
        temp_connection_desc_ptr := iiv$connection_desc_ptr;
      /search_and_unlink/
        WHILE temp_connection_desc_ptr <> NIL DO
          IF temp_connection_desc_ptr^.next_connection_desc_ptr = connection_desc_ptr THEN
            temp_connection_desc_ptr^.next_connection_desc_ptr :=
                  connection_desc_ptr^.next_connection_desc_ptr;
            EXIT /search_and_unlink/;
          ELSE
            temp_connection_desc_ptr := temp_connection_desc_ptr^.next_connection_desc_ptr;
          IFEND;
        WHILEND /search_and_unlink/;
      IFEND;
      { de-allocate the connection description }
      iip$vt_terminate_connection (connection_desc_ptr^.vtp_connection_id, status);

      IF status.normal = FALSE THEN
      return;
      IFEND;

      IF connection_desc_ptr^.output_buffer_entry_loc <> NIL THEN
        FREE connection_desc_ptr^.output_buffer_entry_loc IN osv$job_pageable_heap^;
      IFEND;
      connection_desc_ptr^.output_buffer_exit_loc := NIL;
      conn_desc_entry_descriptor.connection_description_ptr := connection_desc_ptr;
      iip$st_free_queue_entry (iic$connection_description, conn_desc_entry_descriptor, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;

    IFEND;
    iip$clear_lock (iiv$connection_desc_lock, status);
    IF status.normal = FALSE THEN
    return;
    IFEND;


    IF (iiv$int_task_open_file_count = 0) THEN

  { Decrement interactive task count.

      iip$set_lock (iiv$interactive_task_count_lock, osc$wait, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;

      iiv$interactive_task_count := iiv$interactive_task_count - 1;
      iip$clear_lock (iiv$interactive_task_count_lock, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;

    IFEND;
    open_file_entry_descriptor.open_file_description_ptr :=
      open_file_desc_pointer;
    iip$st_free_queue_entry (iic$open_file_description,
      open_file_entry_descriptor, status);
      IF status.normal = FALSE THEN
      return;
      IFEND;


  PROCEND iip$st_close;

MODEND iim$st_close;
