MODULE amm$skip_tape_marks;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amc$condition_code_limits
*copyc amc$fap_request_codes
*copyc ame$device_class_validation
*copyc ame$lfn_program_actions
*copyc ame$skip_program_actions
*copyc ame$skip_validation_errors
*copyc ame$tape_program_actions
*copyc ame$wtmk_validation_errors
*copyc cle$ecc_lexical
*copyc amt$local_file_name
*copyc amt$skip_count
*copyc amt$skip_direction
*copyc amt$skip_unit
*copyc amt$tape_mark_count
*copyc fst$file_reference
*copyc ost$status
?? POP ??
*copyc amp$get_file_attributes
*copyc amp$skip
*copyc clp$validate_name
*copyc fsp$close_file
*copyc fsp$evaluate_file_reference
*copyc fsp$open_file
*copyc fsp$set_evaluated_file_abnormal
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc rmp$get_device_class
*copyc amv$nil_file_identifier
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] AMP$SKIP_TAPE_MARKS', EJECT ??
*copyc amh$skip_tape_marks

  PROCEDURE [XDCL, #GATE] amp$skip_tape_marks
    (    file: fst$file_reference;
         direction: amt$skip_direction;
         count: amt$tape_mark_count;
     VAR status: ost$status);

    VAR
      contains_data: boolean,
      device_assigned: boolean,
      device_class: rmt$device_class,
      file_attachment: array [1 .. 2] of fst$attachment_option,
      file_attr: array [1 .. 2] of amt$get_item,
      file_exists: boolean,
      file_id: amt$file_identifier,
      file_position: amt$file_position,
      file_previously_opened: boolean,
      status_p: ^ost$status;

?? NEWTITLE := 'PROCESS_ERROR', EJECT ??

    PROCEDURE process_error
      (    file: fst$file_reference;
           exception_condition: ost$status_condition;
           request_code: amt$last_operation;
           text: string ( * <= osc$max_string_size);
       VAR status: ost$status);

      VAR
        evaluated_file_reference: fst$evaluated_file_reference;

      fsp$evaluate_file_reference (file, TRUE, evaluated_file_reference, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      fsp$set_evaluated_file_abnormal (evaluated_file_reference, exception_condition, request_code, text,
            status);

    PROCEND process_error;
?? OLDTITLE ??
?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        local_status: ost$status;

      IF file_id <> amv$nil_file_identifier THEN
        fsp$close_file (file_id, local_status);
      IFEND;

    PROCEND abort_handler;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;
    IF (direction < LOWERVALUE (amt$skip_direction)) OR (direction > UPPERVALUE (amt$skip_direction)) THEN
      process_error (file, ame$improper_skip_direction, amc$skip_tape_marks_req, 'AMP$SKIP_TAPE_MARKS',
            status);
      RETURN; {----->
    IFEND;

    IF (count < LOWERVALUE (amt$tape_mark_count)) OR (count > UPPERVALUE (amt$tape_mark_count)) THEN
      process_error (file, ame$improper_skip_count, amc$skip_tape_marks_req, 'AMP$SKIP_TAPE_MARKS', status);
      RETURN; {----->
    IFEND;

    file_attr [1].key := amc$global_access_mode;
    file_attr [2].key := amc$label_type;

    amp$get_file_attributes (file, file_attr, file_exists, file_previously_opened, contains_data, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF NOT file_exists THEN
      process_error (file, ame$file_not_known, amc$skip_tape_marks_req, ' ', status);
      RETURN; {----->
    IFEND;

    rmp$get_device_class (file, device_assigned, device_class, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF device_class <> rmc$magnetic_tape_device THEN
      process_error (file, ame$improper_device_class, amc$skip_tape_marks_req, 'MASS_STORAGE/NULL/TERMINAL',
            status);
      RETURN; {----->
    IFEND;

    IF file_attr [2].label_type = amc$labelled THEN
      process_error (file, ame$improper_labelled_skip_unit, amc$skip_tape_marks_req, ' ', status);
      RETURN; {----->

    ELSEIF NOT (pfc$read IN file_attr [1].global_access_mode) THEN
      process_error (file, ame$skip_requires_read_perm, amc$skip_tape_marks_req, ' ', status);
      RETURN; {----->
    IFEND;

    file_attachment [1].selector := fsc$create_file;
    file_attachment [1].create_file := FALSE;
    file_attachment [2].selector := fsc$open_position;
    file_attachment [2].open_position := amc$open_no_positioning;
    file_id := amv$nil_file_identifier;

    osp$establish_block_exit_hndlr (^abort_handler);

    fsp$open_file (file, amc$record, ^file_attachment, NIL, NIL, NIL, NIL, file_id, status);

    IF status.normal THEN
      amp$skip (file_id, direction, amc$skip_tape_mark, count, file_position, status);

      IF status.normal THEN
        status_p := ^status;
      ELSE
        PUSH status_p;
      IFEND;

      fsp$close_file (file_id, status_p^);
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND amp$skip_tape_marks;
?? OLDTITLE ??
MODEND amm$skip_tape_marks;
