?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := 'NOS/VE SCL Interpreter : Write Tapemark Command' ??

MODULE clm$write_tape_mark_command;

{
{ PURPOSE:
{   This module contains the processor for the write_tape_mark command.
{

?? NEWTITLE := '  Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc cle$ecc_file_reference
*copyc ost$status
*copyc oss$job_paged_literal
?? POP ??

*copyc amp$get_file_attributes
*copyc amp$write_tape_mark
*copyc clp$evaluate_parameters
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc rmp$get_device_class


?? TITLE := '  [XDCL, #GATE] clp$_write_tape_mark_command', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$_write_tape_mark_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{   PROCEDURE (osm$writf) write_tape_mark_pdt (
{     file, f : file = $required
{     status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 5, 14, 10, 55, 36, 241],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'OSM$WRITF'], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$file = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

?? 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);

      IF file_open THEN
        fsp$close_file (file_id, handler_status);
        file_open := FALSE;
      IFEND;

      handler_status.normal := TRUE;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    CONST
      max_class_size = 15,
      max_open_position_size = 4;

    VAR
      class: [STATIC, READ, oss$job_paged_literal] array [rmt$device_class] of record
        size: 1 .. max_class_size,
        value: string (max_class_size),
      recend := [[14, 'CONNECTED_FILE'], [15, 'INTERSTATE_LINK'],
        [11, 'LOCAL_QUEUE'], [3, 'LOG'], [13, 'MAGNETIC_TAPE'],
        [12, 'MASS_STORAGE'], [15, 'MEMORY_RESIDENT'], [7, 'NETWORK'], [4,'NULL'],
        [8, 'PIPELINE'], [5, 'RHFAM'], [8, 'TERMINAL']],

      positioning: [STATIC, READ, oss$job_paged_literal] array [amt$open_position] of record
        size: 1 .. max_open_position_size,
        value: string (max_open_position_size),
      recend := [[4, '$ASIS'], [4, '$BOI'], [4, '$BOP'], [4, '$EOI']],

      explicit_attribute_sources: [STATIC, READ, oss$job_paged_literal] set of amt$attribute_source :=
          [amc$change_file_attributes, amc$file_reference, amc$file_command, amc$file_request,
           amc$add_to_file_description];

    VAR
      file_attributes: array [1 .. 2] of amt$get_item,
      file_attachment: array [1 .. 2] of fst$attachment_option,
      local_file: boolean,
      existing_file: boolean,
      contains_data: boolean,
      file_id: amt$file_identifier,
      file_open: boolean,
      device_assigned: boolean,
      device_class: rmt$device_class,
      open_position: amt$open_position,
      open_position_source: amt$attribute_source,
      ignore_status: ost$status,
      file_set_position_changed: boolean;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_open := FALSE;
    osp$establish_block_exit_hndlr (^abort_handler);

    /write_tape_mark/
    BEGIN

      file_attributes [1].key := amc$open_position;
      file_attributes [2].key := amc$label_type;

      amp$get_file_attributes (pvt [p$file].value^.file_value^, file_attributes,
        local_file, existing_file, contains_data, status);
      IF NOT status.normal THEN
        EXIT /write_tape_mark/;
      IFEND;

      IF NOT local_file THEN
        osp$set_status_abnormal ('CL', cle$file_not_assigned_to_device, 'WRITE_TAPE_MARK', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'MAGNETIC_TAPE', status);
        EXIT /write_tape_mark/;
      IFEND;

      rmp$get_device_class (pvt [p$file].value^.file_value^, device_assigned, device_class, status);
      IF NOT status.normal THEN
        EXIT /write_tape_mark/;
      IFEND;

      IF NOT device_assigned THEN
        osp$set_status_abnormal ('CL', cle$file_not_assigned_to_device, 'WRITE_TAPE_MARK', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'MAGNETIC_TAPE', status);
        EXIT /write_tape_mark/;
      IFEND;

      IF device_class <> rmc$magnetic_tape_device THEN
        osp$set_status_abnormal ('CL', cle$improper_device_class, 'WRITE_TAPE_MARK', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, class [device_class].value, status);
        EXIT /write_tape_mark/;
      IFEND;

      IF file_attributes [2].label_type = amc$labelled THEN
        osp$set_status_abnormal ('CL', cle$improper_labelled_tape_op, 'WRITE_TAPE_MARK', status);
        EXIT /write_tape_mark/;
      IFEND;

      open_position := file_attributes [1].open_position;
      open_position_source := file_attributes [1].source;

      IF (open_position <> amc$open_no_positioning) AND
         (open_position_source IN explicit_attribute_sources) THEN
        osp$set_status_abnormal ('CL', cle$improper_open_position, positioning [open_position].value, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'WRITE_TAPE_MARK', status);
        EXIT /write_tape_mark/;
      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;

      fsp$open_file (pvt [p$file].value^.file_value^, amc$record, ^file_attachment, NIL, NIL, NIL, NIL,
            file_id, status);
      IF NOT status.normal THEN
        EXIT /write_tape_mark/;
      IFEND;
      file_open := TRUE;

      amp$write_tape_mark (file_id, status);
      IF status.normal THEN
        fsp$close_file (file_id, status);
      ELSE
        fsp$close_file (file_id, ignore_status);
      IFEND;

      file_open := FALSE;
    END /write_tape_mark/;

    osp$disestablish_cond_handler;

  PROCEND clp$_write_tape_mark_command;

MODEND clm$write_tape_mark_command;
