*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE Basic_Access_method : Close File' ??
MODULE bam$close;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module performs most of the operations necessary to close a file.

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$improper_file_id
*copyc ame$put_program_actions
*copyc ame$ring_validation_errors
*copyc bac$minimum_open_ring
*copyc bat$global_file_information
*copyc bat$task_file_table
*copyc cle$ecc_miscellaneous
*copyc fse$close_validation_errors
*copyc fst$file_access_options
*copyc mme$condition_codes
*copyc mmt$attribute_keyword
*copyc osd$virtual_address
*copyc ost$caller_identifier
*copyc ost$name
*copyc rmt$device_class
*copyc rmd$tape_declarations
?? POP ??
*copyc baf$task_file_entry_p
*copyc amp$set_file_instance_abnormal
*copyc bap$release_tft_entry
*copyc fmp$close_file
*copyc mmp$set_segment_length
*copyc mmp$write_modified_pages
*copyc osp$file_access_condition
*copyc osp$generate_log_message
*copyc osp$increment_locked_variable
*copyc osp$set_status_abnormal
*copyc osp$verify_system_privilege
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] bap$close', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$close
    (    file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      local_status: ost$status,
      open_count: integer;

    status.normal := TRUE;
    #CALLER_ID (caller_id);

    file_instance := baf$task_file_entry_p (file_identifier);
    IF file_instance = NIL THEN
      osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, 'AMP$CLOSE', status);
      RETURN; {----->

    ELSEIF caller_id.ring > file_instance^.open_ring THEN
      amp$set_file_instance_abnormal (file_identifier, ame$ring_validation_error, amc$close_req, '', status);
      RETURN; {----->

    ELSEIF NOT (file_instance^.close_allowed) THEN
      amp$set_file_instance_abnormal (file_identifier, fse$close_of_target_not_allowed, amc$close_req, '',
            status);
      RETURN; {----->
    IFEND;

    IF (file_instance^.device_class = rmc$mass_storage_device)
{ } AND (file_instance^.access_level = amc$record)
{ } AND file_instance^.instance_of_open_modified
{ } AND (file_instance^.file_pva <> NIL) THEN

      mmp$set_segment_length (file_instance^.file_pva, bac$minimum_open_ring,
            file_instance^.global_file_information^.eoi_byte_address, local_status);
      IF (NOT local_status.normal) AND osp$file_access_condition (local_status) THEN
        status := local_status;
      IFEND;

      { Protect against an escaped allocation condition at detach}
      bap$write_modified_pages (file_instance, file_identifier, local_status);
      IF (NOT local_status.normal) AND osp$file_access_condition (local_status) THEN
        status := local_status;
      IFEND;
    IFEND;

    fmp$close_file (file_instance, local_status);
    IF (NOT local_status.normal) AND osp$file_access_condition (local_status)
{ } AND (file_instance^.global_file_information <> NIL) THEN
      osp$increment_locked_variable (file_instance^.global_file_information^.open_count, 0, open_count);
      status := local_status;
      RETURN; {----->
    IFEND;

{Note: We still end up here, when fmp$close_file failed and file_instance^.global_file_information = NIL!?
    bap$release_tft_entry (file_instance, file_identifier.ordinal);

  PROCEND bap$close;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] bap$write_modified_pages', EJECT ??

  PROCEDURE [XDCL] bap$write_modified_pages
    (    file_instance: ^bat$task_file_entry;
         file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      mm_status: ost$status,
      status_p: ^ost$status;

    status.normal := TRUE;
    IF (file_instance^.file_pva <> NIL)
{ } AND ((file_instance^.instance_attributes.dynamic_label.access_mode * $pft$usage_selections
          [pfc$shorten, pfc$append, pfc$modify]) <> $pft$usage_selections []) THEN

      mmp$write_modified_pages (file_instance^.file_pva, osc$maximum_offset, osc$wait, mm_status);
      IF (NOT mm_status.normal) THEN
        IF NOT osp$file_access_condition (mm_status) THEN
          PUSH status_p;
          IF mm_status.condition = mme$io_write_error THEN
            amp$set_file_instance_abnormal (file_identifier, ame$unrecovered_write_error, amc$close_req, ' ',
                  status);
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], status, status_p^);
          ELSE
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], mm_status, status_p^);
          IFEND;
        ELSE
          status := mm_status;
        IFEND;
      IFEND;
    IFEND;

  PROCEND bap$write_modified_pages;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL] bap$inhibit_implicit_detach', EJECT ??

  PROCEDURE [XDCL] bap$inhibit_implicit_detach
    (    file_identifier: amt$file_identifier);

    VAR
      file_instance: ^bat$task_file_entry;

    file_instance := baf$task_file_entry_p (file_identifier);
    IF file_instance <> NIL THEN
      file_instance^.global_file_information^.implicit_detach_inhibited := TRUE;
    IFEND;

  PROCEND bap$inhibit_implicit_detach;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL, #GATE] bap$set_close_allowed', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$set_close_allowed
    (    file_identifier: amt$file_identifier);

    VAR
      file_instance: ^bat$task_file_entry;

    osp$verify_system_privilege;
    file_instance := baf$task_file_entry_p (file_identifier);
    IF file_instance <> NIL THEN
      file_instance^.close_allowed := TRUE;
    IFEND;

  PROCEND bap$set_close_allowed;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL, #GATE] bap$set_return_at_close', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$set_return_at_close
    (    file_identifier: amt$file_identifier);

    VAR
      file_instance: ^bat$task_file_entry;

    osp$verify_system_privilege;
    file_instance := baf$task_file_entry_p (file_identifier);
    IF file_instance <> NIL THEN
      file_instance^.instance_attributes.dynamic_label.return_option := amc$return_at_close;
      file_instance^.instance_attributes.dynamic_label.return_option_source := amc$open_request;
    IFEND;

  PROCEND bap$set_return_at_close;
?? OLDTITLE ??
MODEND bam$close;
