?? LEFT := 1, RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Magnetic tape command management routines' ??
?? NEWTITLE := '  IOM$TAPE_COMMAND_PROCEDURES' ??
MODULE iom$tape_command_procedures;

{ Purpose: This module contains code that supports magnetic tape commands.
{

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

  CONST
    one_second = 1000 {milliseconds};

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

*copyc clt$value
*copyc dme$tape_errors
*copyc jmt$system_supplied_name
*copyc ofe$error_codes
*copyc osd$integer_limits
*copyc ost$name
*copyc rme$avr_tape_errors
*copyc rmt$external_vsn

?? TITLE := '    Global Procedures Referenced by this Module', EJECT ??

*copyc avp$removable_media_operator
*copyc ifp$invoke_pause_utility
*copyc iop$access_tusl_entry
*copyc iop$determine_density_support
*copyc iop$get_tape_mount_information
*copyc iop$set_assignment_in_tusl
*copyc iop$tape_mount_count
*copyc iop$terminate_assignment
*copyc osp$establish_condition_handler
*copyc osp$disestablish_cond_handler
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause
*copyc pmp$long_term_wait
*copyc pmp$ready_task
*copyc rmp$log_debug_message

?? TITLE := '    Global Variables referenced this Module', EJECT ??

*copyc iov$tusl_p

?? OLDTITLE ??
?? NEWTITLE := 'iop$assign_device_command', EJECT ??

  PROCEDURE [XDCL, #GATE] iop$assign_device_command
    (    job_name: jmt$system_supplied_name;
         element_name: ost$name;
         external_vsn: rmt$external_vsn;
     VAR status: ost$status);

?? NEWTITLE := '  assign_device_command_handler  ', EJECT ??

    PROCEDURE assign_device_command_handler
      (    condition: pmt$condition;
           p_condition_info: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        ignore_status: ost$status;

      CASE condition.selector OF
      = ifc$interactive_condition =
        CASE condition.interactive_condition OF
        = ifc$pause_break, ifc$job_reconnect =
          ifp$invoke_pause_utility (ignore_status);
        = ifc$terminate_break =
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rmc$resource_management_id, condition, save_area, status,
                ignore_status);
          EXIT iop$assign_device_command;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        CASEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      CASEND;

    PROCEND assign_device_command_handler;

?? OLDTITLE ??

    VAR
      all_tape_mounts_found: boolean,
      debug_message_logged: boolean,
      density_supported: boolean,
      info_array_index: ost$positive_integers,
      mount_ordinal: ost$positive_integers,
      mount_requests: integer,
      rvl_info_array_p: ^array [1 .. * ] of iot$rvl_entry_information,
      tape_mount_count: integer,
      tusl_ordinal: iot$tusl_ordinal;

    IF NOT avp$removable_media_operator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'removable_media_operator', status);
      RETURN;
    IFEND;

    debug_message_logged := FALSE;
    REPEAT
      IF NOT debug_message_logged THEN
        rmp$log_debug_message (' Calling iop$tape_mount_count');
      IFEND;
      iop$tape_mount_count (tape_mount_count, status);
      IF NOT status.normal THEN
        IF status.condition = dme$unable_to_lock_tape_table THEN
          IF NOT debug_message_logged THEN
            rmp$log_debug_message (' Waiting for tape table lock');
            debug_message_logged := TRUE;
          IFEND;
          osp$establish_condition_handler (^assign_device_command_handler, {handle block exit} FALSE);
          pmp$long_term_wait (one_second, one_second);
          osp$disestablish_cond_handler;
        ELSE
          tape_mount_count := 0;
          status.normal := TRUE;
        IFEND;
      IFEND;
    UNTIL status.normal;

    IF tape_mount_count <= 0 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$no_tape_mount_pending, external_vsn, status);
      RETURN;
    IFEND;

    PUSH rvl_info_array_p: [LOWERBOUND (rvl_info_array_p^) .. tape_mount_count];
    REPEAT
      REPEAT
        IF NOT debug_message_logged THEN
          rmp$log_debug_message (' Calling iop$get_tape_mount_information');
        IFEND;
        iop$get_tape_mount_information (rvl_info_array_p, all_tape_mounts_found, status);
        IF NOT status.normal THEN
          IF status.condition = dme$unable_to_lock_tape_table THEN
            IF NOT debug_message_logged THEN
              rmp$log_debug_message (' Waiting for tape table lock');
              debug_message_logged := TRUE;
            IFEND;
            osp$establish_condition_handler (^assign_device_command_handler, {handle block exit} FALSE);
            pmp$long_term_wait (one_second, one_second);
            osp$disestablish_cond_handler;
          ELSE
            RETURN;
          IFEND;
        IFEND;
      UNTIL status.normal OR (status.condition <> dme$unable_to_lock_tape_table);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF NOT all_tape_mounts_found THEN
        tape_mount_count := tape_mount_count + 1;
        PUSH rvl_info_array_p: [LOWERBOUND (rvl_info_array_p^) .. tape_mount_count];
      IFEND;
    UNTIL all_tape_mounts_found;

    mount_requests := 0;
  /find_mount_requests/
    FOR info_array_index := LOWERBOUND (rvl_info_array_p^) TO UPPERBOUND (rvl_info_array_p^) DO
      IF rvl_info_array_p^ [info_array_index].null_entry THEN
        EXIT /find_mount_requests/;
      IFEND;
      IF job_name = jmc$blank_system_supplied_name THEN
        IF rvl_info_array_p^ [info_array_index].current_vsn = external_vsn THEN
          mount_requests := mount_requests + 1;
          mount_ordinal := info_array_index;
        IFEND;
      ELSE
        IF (rvl_info_array_p^ [info_array_index].current_vsn = external_vsn) AND
              (rvl_info_array_p^ [info_array_index].ssn = job_name) THEN
          mount_requests := 1;
          mount_ordinal := info_array_index;
          EXIT /find_mount_requests/;
        IFEND;
      IFEND;
    FOREND;

    IF mount_requests = 0 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$no_tape_mount_pending, external_vsn, status);
      RETURN;
    IFEND;

    IF mount_requests > 1 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$system_name_required, external_vsn, status);
      RETURN;
    IFEND;

  /scan_tusl/
    BEGIN
      FOR tusl_ordinal := LOWERBOUND (iov$tusl_p^) TO UPPERBOUND (iov$tusl_p^) DO
        IF iov$tusl_p^ [tusl_ordinal].element_name = element_name THEN
          EXIT /scan_tusl/;
        IFEND;
      FOREND;
      osp$set_status_abnormal (rmc$resource_management_id, rme$undefined_element_name, element_name, status);
      RETURN;
    END /scan_tusl/;

    iop$determine_density_support (iov$tusl_p^ [tusl_ordinal].unit_type,
          rvl_info_array_p^ [mount_ordinal].requested_tape_characteristics.density, density_supported);
    IF NOT density_supported THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$density_not_supported, element_name, status);
      RETURN;
    IFEND;

    debug_message_logged := FALSE;
    REPEAT
      IF NOT debug_message_logged THEN
        rmp$log_debug_message (' Calling iop$set_assignment_in_tusl');
      IFEND;
      iop$set_assignment_in_tusl (tusl_ordinal, rvl_info_array_p^ [mount_ordinal].sfid,
            rvl_info_array_p^ [mount_ordinal].ssn, external_vsn, status);
      IF NOT status.normal THEN
        IF status.condition = dme$unable_to_lock_tape_table THEN
          IF NOT debug_message_logged THEN
            rmp$log_debug_message (' Waiting for tape table lock');
            debug_message_logged := TRUE;
          IFEND;
          osp$establish_condition_handler (^assign_device_command_handler, {handle block exit} FALSE);
          pmp$long_term_wait (one_second, one_second);
          osp$disestablish_cond_handler;
        ELSE
          RETURN;
        IFEND;
      IFEND;
    UNTIL status.normal OR (status.condition <> dme$unable_to_lock_tape_table);

  PROCEND iop$assign_device_command;

?? TITLE := '    IOP$REASSIGN_DEVICE_COMMAND', EJECT ??

  PROCEDURE [XDCL, #GATE] iop$reassign_device_command
    (    element_name: ost$name;
     VAR status: ost$status);

?? NEWTITLE := '  reassign_device_command_handler  ', EJECT ??

    PROCEDURE reassign_device_command_handler
      (    condition: pmt$condition;
           p_condition_info: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        ignore_status: ost$status;

      CASE condition.selector OF
      = ifc$interactive_condition =
        CASE condition.interactive_condition OF
        = ifc$pause_break, ifc$job_reconnect =
          ifp$invoke_pause_utility (ignore_status);
        = ifc$terminate_break =
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rmc$resource_management_id, condition, save_area, status,
                ignore_status);
          EXIT iop$reassign_device_command;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        CASEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      CASEND;

    PROCEND reassign_device_command_handler;

?? OLDTITLE ??

    VAR
      debug_message_logged: boolean,
      local_status: ost$status,
      tusl_entry_access: iot$tusl_entry_access,
      tusl_ordinal: iot$tusl_ordinal;

    status.normal := TRUE;

    IF NOT avp$removable_media_operator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'REMOVABLE_MEDIA_OPERATOR', status);
      RETURN;
    IFEND;

  /scan_tusl/
    BEGIN

      FOR tusl_ordinal := LOWERBOUND (iov$tusl_p^) TO UPPERBOUND (iov$tusl_p^) DO
        IF iov$tusl_p^ [tusl_ordinal].element_name = element_name THEN
          EXIT /scan_tusl/;
        IFEND;
      FOREND;

      osp$set_status_abnormal (rmc$resource_management_id, rme$undefined_element_name, element_name, status);
      RETURN;

    END /scan_tusl/;

    debug_message_logged := FALSE;
    REPEAT
      IF NOT debug_message_logged THEN
        rmp$log_debug_message (' Calling iop$access_tusl_entry');
      IFEND;
      tusl_entry_access.operation := ioc$set_operator_reassign;
      iop$access_tusl_entry (tusl_ordinal, tusl_entry_access, status);
      IF NOT status.normal THEN
        IF status.condition = dme$unable_to_lock_tape_table THEN
          IF NOT debug_message_logged THEN
            rmp$log_debug_message (' Waiting for tape table lock');
            debug_message_logged := TRUE;
          IFEND;
          osp$establish_condition_handler (^reassign_device_command_handler, {handle block exit} FALSE);
          pmp$long_term_wait (one_second, one_second);
          osp$disestablish_cond_handler;
        IFEND;
      IFEND;
    UNTIL status.normal OR (status.condition <> dme$unable_to_lock_tape_table);

  PROCEND iop$reassign_device_command;

?? TITLE := '    IOP$TERMINATE_TAPE_ASSIGNMENT', EJECT ??

  PROCEDURE [XDCL, #GATE] iop$terminate_tape_assignment
    (    external_vsn: rmt$external_vsn;
         message: string (osc$max_string_size);
         ssn: jmt$system_supplied_name;
     VAR status: ost$status);

?? NEWTITLE := '  term_tape_assignment_handler  ', EJECT ??

    PROCEDURE term_tape_assignment_handler
      (    condition: pmt$condition;
           p_condition_info: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        ignore_status: ost$status;

      CASE condition.selector OF
      = ifc$interactive_condition =
        CASE condition.interactive_condition OF
        = ifc$pause_break, ifc$job_reconnect =
          ifp$invoke_pause_utility (ignore_status);
        = ifc$terminate_break =
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rmc$resource_management_id, condition, save_area, status,
                ignore_status);
          EXIT iop$terminate_tape_assignment;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        CASEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      CASEND;

    PROCEND term_tape_assignment_handler;

?? OLDTITLE ??

    VAR
      all_tape_mounts_found: boolean,
      debug_message_logged: boolean,
      info_array_index: ost$positive_integers,
      mount_requests: integer,
      mount_ordinal: ost$positive_integers,
      rvl_info_array_p: ^array [1 .. * ] of iot$rvl_entry_information,
      tape_mount_count: integer;

    IF NOT avp$removable_media_operator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'REMOVABLE_MEDIA_OPERATOR', status);
      RETURN;
    IFEND;

    debug_message_logged := FALSE;
    REPEAT
      IF NOT debug_message_logged THEN
        rmp$log_debug_message (' Calling iop$tape_mount_count');
      IFEND;
      iop$tape_mount_count (tape_mount_count, status);
      IF NOT status.normal THEN
        IF status.condition = dme$unable_to_lock_tape_table THEN
          IF NOT debug_message_logged THEN
            rmp$log_debug_message (' Waiting for tape table lock');
            debug_message_logged := TRUE;
          IFEND;
          osp$establish_condition_handler (^term_tape_assignment_handler, {handle block exit} FALSE);
          pmp$long_term_wait (one_second, one_second);
          osp$disestablish_cond_handler;
        ELSE
          tape_mount_count := 0;
          status.normal := TRUE;
        IFEND;
      IFEND;
    UNTIL status.normal;

    IF tape_mount_count <= 0 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$no_tape_mount_pending, external_vsn, status);
      RETURN;
    IFEND;

    PUSH rvl_info_array_p: [LOWERBOUND (rvl_info_array_p^) .. tape_mount_count];
    REPEAT
      REPEAT
        IF NOT debug_message_logged THEN
          rmp$log_debug_message (' Calling iop$get_tape_mount_information');
        IFEND;
        iop$get_tape_mount_information (rvl_info_array_p, all_tape_mounts_found, status);
        IF NOT status.normal THEN
          IF status.condition = dme$unable_to_lock_tape_table THEN
            IF NOT debug_message_logged THEN
              rmp$log_debug_message (' Waiting for tape table lock');
              debug_message_logged := TRUE;
            IFEND;
            osp$establish_condition_handler (^term_tape_assignment_handler, {handle block exit} FALSE);
            pmp$long_term_wait (one_second, one_second);
            osp$disestablish_cond_handler;
          ELSE
            RETURN;
          IFEND;
        IFEND;
      UNTIL status.normal OR (status.condition <> dme$unable_to_lock_tape_table);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF NOT all_tape_mounts_found THEN
        tape_mount_count := tape_mount_count + 1;
        PUSH rvl_info_array_p: [LOWERBOUND (rvl_info_array_p^) .. tape_mount_count];
      IFEND;
    UNTIL all_tape_mounts_found;

    mount_requests := 0;
  /search_mount_requests/
    BEGIN
      IF ssn = jmc$blank_system_supplied_name THEN
        FOR info_array_index := LOWERBOUND (rvl_info_array_p^) TO UPPERBOUND (rvl_info_array_p^) DO
          IF rvl_info_array_p^ [info_array_index].null_entry THEN
            EXIT /search_mount_requests/;
          IFEND;
          IF rvl_info_array_p^ [info_array_index].current_vsn = external_vsn THEN
            mount_requests := mount_requests + 1;
            mount_ordinal := info_array_index;
          IFEND;
        FOREND;
        EXIT /search_mount_requests/;

      ELSE { ssn <> jmc$blank_system_supplied_name
        FOR info_array_index := LOWERBOUND (rvl_info_array_p^) TO UPPERBOUND (rvl_info_array_p^) DO
          IF rvl_info_array_p^ [info_array_index].null_entry THEN
            EXIT /search_mount_requests/;
          IFEND;
          IF (rvl_info_array_p^ [info_array_index].current_vsn = external_vsn) AND
                (rvl_info_array_p^ [info_array_index].ssn = ssn) THEN
            mount_requests := 1;
            mount_ordinal := info_array_index;
            EXIT /search_mount_requests/;
          IFEND;
        FOREND;
      IFEND;

    END /search_mount_requests/;

    IF mount_requests < 1 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$no_tape_mount_pending, external_vsn, status);
      RETURN;
    ELSEIF mount_requests > 1 THEN
      osp$set_status_abnormal (rmc$resource_management_id, rme$system_name_req_for_term, external_vsn,
            status);
      RETURN;
    IFEND;

    debug_message_logged := FALSE;
    REPEAT
      IF NOT debug_message_logged THEN
        rmp$log_debug_message (' Calling iop$terminate_assignment');
      IFEND;
      iop$terminate_assignment (rvl_info_array_p^ [mount_ordinal].sfid,
            rvl_info_array_p^ [mount_ordinal].ssn, message, status);
      IF NOT status.normal THEN
        IF status.condition = dme$unable_to_lock_tape_table THEN
          IF NOT debug_message_logged THEN
            rmp$log_debug_message (' Waiting for tape table lock');
            debug_message_logged := TRUE;
          IFEND;
          osp$establish_condition_handler (^term_tape_assignment_handler, {handle block exit} FALSE);
          pmp$long_term_wait (one_second, one_second);
          osp$disestablish_cond_handler;
        ELSE
          RETURN;
        IFEND;
      IFEND;
    UNTIL status.normal OR (status.condition <> dme$unable_to_lock_tape_table);

  PROCEND iop$terminate_tape_assignment;

MODEND iom$tape_command_procedures;
