?? NEWTITLE := 'NOS/VE :  BASIC ACCESS METHOD : Loaded ring cleanup' ??
MODULE bam$loaded_ring_cleanup;
?? RIGHT := 110 ??
?? NEWTITLE := 'Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amc$condition_code_limits
*copyc ame$put_program_actions
*copyc amt$fap_declarations
*copyc amt$file_byte_address
*copyc amt$file_identifier
*copyc fme$file_management_errors
*copyc oss$job_paged_literal
*copyc ost$status
*copyc pmd$system_log_interface
?? POP ??
*copyc amp$set_file_instance_abnormal
*copyc bap$mark_fap_layer_closed
*copyc bap$mark_fap_layer_open
*copyc bap$set_close_allowed
*copyc bap$set_task_cleanup_initiated
*copyc mmp$verify_access
*copyc osp$append_status_integer
*copyc osp$disestablish_cond_handler
*copyc osp$enforce_exception_policies
*copyc osp$establish_condition_handler
*copyc osp$file_access_condition
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause

  FUNCTION [XREF] baf$verify_tft_before_cleanup: boolean;

*copyc bav$last_tft_entry
*copyc bav$task_cleanup_initiated
*copyc bav$task_file_table
*copyc bav$tft_entry_assignment
*copyc clv$processing_phase
*copyc osv$initial_exception_context

?? TITLE := 'Global Declarations Declared by this Module', EJECT ??

  TYPE
    t$tft_entries = set of 0 .. amc$max_file_id_ordinal;

  VAR
    close_call_block: [READ, oss$job_paged_literal] amt$call_block := [amc$close_req];

{   Purpose:
{    The purpose of this module is to permit each fap associated
{    with an instance of a file to perform its close processing
{    during task termination.
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL] bap$loaded_ring_cleanup', EJECT ??

  PROCEDURE [XDCL] bap$loaded_ring_cleanup;

    VAR
      call_count: integer,
      fap_status: ost$status,
      skip_tft_entries: t$tft_entries;

?? NEWTITLE := 'p$loaded_ring_cleanup', EJECT ??

    PROCEDURE p$loaded_ring_cleanup;

      VAR
        fid_ordinal: amt$file_id_ordinal,
        ignore_status: ost$status,
        ok: boolean,
        pass: 1 .. 2;

?? NEWTITLE := 'PROCEDURE handle_condition', EJECT ??

      PROCEDURE handle_condition
        (    condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR status: ost$status);

        status.normal := TRUE;

        CASE condition.selector OF
        = pmc$system_conditions, mmc$segment_access_condition =

{ Purpose:
{   If a fap is called during loaded ring cleanup, it is desirable
{   to save the abnormal status, if any, generated by the fap.

          osp$set_status_from_condition (amc$access_method_id, condition, save_area, fap_status,
                ignore_status);

          EXIT p$loaded_ring_cleanup; {----->

        = pmc$block_exit_processing =

{ Purpose:
{      1.Ensure that all faps in this ring are called.
{         a.Protects against faps which abort during close processing.
{         b.Protects against faps which call pmp$exit or pmp$abort
{      2.Causes all conditions generated by faps during close processing
{         to be logged.

          status := fap_status;
{This is a safety check, but what should we do here, when we loop?
          #SPOIL (call_count);
          IF call_count <= 2 * bav$last_tft_entry THEN
            p$loaded_ring_cleanup;
          IFEND;

        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        CASEND;

      PROCEND handle_condition;
?? OLDTITLE ??
?? EJECT ??

      #SPOIL (call_count);
      call_count := call_count + 0;
      #SPOIL (call_count);
      osp$establish_condition_handler (^handle_condition, TRUE);

      FOR pass := 1 TO 2 DO
        FOR fid_ordinal := 1 TO bav$last_tft_entry DO
          IF (bav$tft_entry_assignment^ (fid_ordinal, 1) = fmc$entry_assigned) AND
                (NOT (fid_ordinal IN skip_tft_entries)) AND (bav$task_file_table^ [fid_ordinal].
                close_allowed OR (pass = 2)) THEN
            close_fap_layers (fid_ordinal, pass, ok);
            IF NOT ok THEN
              skip_tft_entries := skip_tft_entries + $t$tft_entries [fid_ordinal];
            IFEND;
          IFEND;
        FOREND;
      FOREND;

      osp$disestablish_cond_handler;

    PROCEND p$loaded_ring_cleanup;
?? OLDTITLE ??
?? EJECT ??

    fap_status.normal := TRUE;
    IF NOT bav$task_cleanup_initiated THEN
      bap$set_task_cleanup_initiated;
    IFEND;

    IF bav$task_file_table = NIL THEN
      RETURN; {----->
    IFEND;

    call_count := 0;
    skip_tft_entries := $t$tft_entries [];
    #SPOIL (call_count);
    p$loaded_ring_cleanup;

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

  PROCEDURE [XDCL] bap$monitor_loaded_ring_cleanup;

    VAR
      call_count: integer,
      fap_status: ost$status,
      skip_tft_entries: t$tft_entries;

?? NEWTITLE := 'p$monitor_loaded_ring_cleanup', EJECT ??

    PROCEDURE p$monitor_loaded_ring_cleanup;

      VAR
        fid_ordinal: amt$file_id_ordinal,
        ignore_status: ost$status,
        ok: boolean;

?? NEWTITLE := 'PROCEDURE handle_condition', EJECT ??

      PROCEDURE handle_condition
        (    condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR status: ost$status);

        status.normal := TRUE;

        CASE condition.selector OF
        = pmc$system_conditions, mmc$segment_access_condition =

{ Purpose:
{   If a fap is called during loaded ring cleanup, it is desirable
{   to save the abnormal status, if any, generated by the fap.

          osp$set_status_from_condition (amc$access_method_id, condition, save_area, fap_status,
                ignore_status);

          EXIT p$monitor_loaded_ring_cleanup; {----->

        = pmc$block_exit_processing =

{ Purpose:
{      1.Ensure that all faps in this ring are called.
{         a.Protects against faps which abort during close processing.
{         b.Protects against faps which call pmp$exit or pmp$abort
{      2.Causes all conditions generated by faps during close processing
{         to be logged.

          status := fap_status;
{This is a safety check, but what should we do here, when we loop?
          #SPOIL (call_count);
          IF call_count <= 2 * bav$last_tft_entry THEN
            p$monitor_loaded_ring_cleanup;
          IFEND;

        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        CASEND;

      PROCEND handle_condition;
?? OLDTITLE ??
?? EJECT ??

      #SPOIL (call_count);
      call_count := call_count + 0;
      #SPOIL (call_count);
      osp$establish_condition_handler (^handle_condition, TRUE);

{ close_allowed is set to FALSE for targets of connected files, all targets
{ are closed in epilog processing.
      FOR fid_ordinal := 1 TO bav$last_tft_entry DO
        IF (bav$tft_entry_assignment^ (fid_ordinal, 1) = fmc$entry_assigned) AND
              (NOT (fid_ordinal IN skip_tft_entries)) AND (bav$task_file_table^ [fid_ordinal].
              close_allowed) AND ((bav$task_file_table^ [fid_ordinal].module_dynamically_loaded) OR
              (bav$task_file_table^ [fid_ordinal].device_class = rmc$magnetic_tape_device)) THEN

          close_fap_layers (fid_ordinal, {pass=} 2, ok);
          {pass=2 implies wait on volume down}
          IF NOT ok THEN
            skip_tft_entries := skip_tft_entries + $t$tft_entries [fid_ordinal];
          IFEND;
        IFEND;
      FOREND;

      osp$disestablish_cond_handler;

    PROCEND p$monitor_loaded_ring_cleanup;
?? OLDTITLE ??
?? EJECT ??
    fap_status.normal := TRUE;

    IF bav$task_file_table = NIL THEN
      RETURN; {----->
    IFEND;

    call_count := 0;
    skip_tft_entries := $t$tft_entries [];
    #SPOIL (call_count);
    p$monitor_loaded_ring_cleanup;

  PROCEND bap$monitor_loaded_ring_cleanup;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE close_fap_layers', EJECT ??

  PROCEDURE close_fap_layers
    (    fid_ordinal: amt$file_id_ordinal;
         pass: 1 .. 2;
     VAR layer_accessable: boolean);

    VAR
      bam_status: ost$status,
      execution_ring: ost$ring,
      file_identifier: amt$file_identifier,
      ignore_status: ost$status,
      layer: ^bat$fap_descriptor,
      layer_number: amt$fap_layer_number,
      layer_unaccessable_count: integer,
      local_layer_accessable: boolean,
      tft_entry: ^bat$task_file_entry;

?? NEWTITLE := 'PROCEDURE [INLINE] close_layer', EJECT ??

    PROCEDURE [INLINE] close_layer
      (VAR layer_accessable: boolean);

      VAR
        context: ^ost$ecp_exception_context,
        file_access_condition: boolean;

      PUSH context;
      context^ := osv$initial_exception_context;

      IF NOT mmp$verify_access (#LOC (layer), mmc$va_read) THEN
        layer_accessable := FALSE;
        osp$set_status_abnormal (amc$access_method_id, fme$system_error,
              'Unable to access FAP Descriptor of TFT Entry: ', bam_status);
        osp$append_status_integer (osc$status_parameter_delimiter, fid_ordinal, 10, FALSE, bam_status);
        osp$append_status_integer (osc$status_parameter_delimiter, tft_entry^.sequence_number, 10, FALSE,
              bam_status);
        osp$append_status_integer (osc$status_parameter_delimiter, layer_number, 10, FALSE, bam_status);
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], bam_status, ignore_status);

      ELSEIF (NOT layer^.layer_closed)
{      } AND (layer^.loaded_ring = execution_ring)
{      } AND (layer^.access_method <> NIL) THEN

        terminate_file (file_identifier, tft_entry^, layer^, layer_number, bam_status);
        IF (pass = 2) AND osp$file_access_condition (bam_status) THEN
          context^.file.selector := osc$ecp_file_identifier;
          context^.file.file_identifier := file_identifier;

          REPEAT
            context^.condition_status := bam_status;
            osp$enforce_exception_policies (context^);
            bam_status := context^.condition_status;
            IF context^.wait THEN
              terminate_file (file_identifier, tft_entry^, layer^, layer_number, bam_status);
            IFEND;
          UNTIL bam_status.normal OR (NOT osp$file_access_condition (bam_status)) OR (NOT context^.wait);
        IFEND;

        file_access_condition := osp$file_access_condition (bam_status);
        IF (NOT bam_status.normal) AND (NOT file_access_condition) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], bam_status,
                ignore_status);
        IFEND;

        IF (NOT file_access_condition) OR (pass = 2) THEN
          bap$mark_fap_layer_closed (file_identifier, layer_number, bam_status);
          IF bam_status.normal THEN
            IF (pass = 2) AND (NOT tft_entry^.close_allowed) THEN
              bap$set_close_allowed (file_identifier);
            IFEND;
            layer^.access_method^ (file_identifier, close_call_block, layer_number, bam_status);
            IF pass = 2 THEN
              IF osp$file_access_condition (bam_status) THEN
                context^.file.selector := osc$ecp_file_identifier;
                context^.file.file_identifier := file_identifier;

                REPEAT
                  context^.condition_status := bam_status;
                  osp$enforce_exception_policies (context^);
                  bam_status := context^.condition_status;
                  IF context^.wait THEN
                    layer^.access_method^ (file_identifier, close_call_block, layer_number, bam_status);
                  IFEND;
                UNTIL bam_status.normal OR (NOT osp$file_access_condition (bam_status)) OR
                      (NOT context^.wait);
              IFEND;
            ELSEIF osp$file_access_condition (bam_status) THEN
              bap$mark_fap_layer_open (file_identifier, layer_number, bam_status);
            IFEND;
          IFEND;
          IF (NOT bam_status.normal) AND (bam_status.condition <> ame$unrecovered_write_error) THEN
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], bam_status,
                  ignore_status);
          IFEND;
        IFEND;
      IFEND;

    PROCEND close_layer;
?? OLDTITLE ??
?? EJECT ??

    execution_ring := #RING (^layer_number);
    layer_accessable := TRUE;
    tft_entry := ^bav$task_file_table^ [fid_ordinal];
    file_identifier.ordinal := fid_ordinal;
    file_identifier.sequence := tft_entry^.sequence_number;
    IF tft_entry^.fap_control_information.fap_array = NIL THEN
      layer := ^tft_entry^.fap_control_information.first_fap;
      layer_number := 0;
      close_layer (layer_accessable);

    ELSEIF mmp$verify_access (#LOC (tft_entry^.fap_control_information.fap_array), mmc$va_read) THEN
      layer_unaccessable_count := 0;
      FOR layer_number := 0 TO UPPERBOUND (tft_entry^.fap_control_information.fap_array^) DO
        layer := ^tft_entry^.fap_control_information.fap_array^ [layer_number];
        close_layer (local_layer_accessable);
        IF NOT local_layer_accessable THEN
          layer_unaccessable_count := layer_unaccessable_count + 1;
        IFEND;
        IF layer_unaccessable_count > 0 THEN
{ Maybe, some are accessable? But what I saw, I think, when one is bad all will be bad.
          layer_accessable := FALSE;
        IFEND;
      FOREND;

    ELSE
      layer_accessable := FALSE;
      osp$set_status_abnormal (amc$access_method_id, fme$system_error,
            'Unable to access FAP Descriptor of TFT Entry: ', bam_status);
      osp$append_status_integer (osc$status_parameter_delimiter, fid_ordinal, 10, FALSE, bam_status);
      osp$append_status_integer (osc$status_parameter_delimiter, tft_entry^.sequence_number, 10, FALSE,
            bam_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], bam_status, ignore_status);
    IFEND;

  PROCEND close_fap_layers;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [INLINE] terminate_file', EJECT ??

  PROCEDURE [INLINE] terminate_file
    (    file_identifier: amt$file_identifier;
         file_instance: bat$task_file_entry;
         layer: bat$fap_descriptor;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);


    VAR
      call_block: amt$call_block,
      dummy_area: cell,
      ignore_byte_address: amt$file_byte_address;

    status.normal := TRUE;

    CASE file_instance.instance_attributes.static_label.file_organization OF
    = amc$sequential, amc$byte_addressable =
      IF (file_instance.private_read_information = NIL) AND
            (file_instance.global_file_information^.positioning_info.record_info.current_byte_address =
            file_instance.global_file_information^.eoi_byte_address) AND
            (file_instance.global_file_information^.positioning_info.record_info.file_position =
            amc$mid_record) AND (file_instance.global_file_information^.last_access_operation =
            amc$put_partial_req) THEN

{ terminate the file.

        call_block.operation := amc$put_partial_req;
        call_block.putp.working_storage_area := ^dummy_area;
        call_block.putp.working_storage_length := 0;
        call_block.putp.byte_address := ^ignore_byte_address;
        call_block.putp.term_option := amc$terminate;
        layer.access_method^ (file_identifier, call_block, layer_number, status);
      IFEND;
    ELSE
    CASEND;

  PROCEND terminate_file;
?? OLDTITLE ??
MODEND bam$loaded_ring_cleanup;
