MODULE amm$trace_routines;
?? RIGHT := 110 ??
{  This module contains file access procedures, and error exit procedures
{ that allow obtaining a trace of file access for a particular file,
{ in a task.   All output is written to $am_trace, which may not have
{ one of these faps associated with it.  The following are available:
{ ERROR_EXIT_PROCEDURES:
{    (set_file_attributes een=    )
{ -  amp$full_table_eep_trace
{       Along with the error all of BAMs tables are displayed.
{ FILE_ACCESS_PROCEDURES:
{    (set_file_attributes fap=   )
{ -  amp$full_table_fap_trace
{        In addition to the call_block trace, all of bam tables are displayed
{        after each operation.
{ -  amp$trace_calls
{        Displays the operation that is occuring, and the ring.
{ -  amp$trace_call_blocks
{        Displays the operation, data input to the operation, and the result
{        of the operation.
{ -  amp$trace_timings
{        In addition to the call_block trace, provides data on timing of the
{        operation.
{

?? PUSH (LISTEXT := ON) ??
*copyc i#current_sequence_position
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc fmc$entry_assigned
*copyc osd$virtual_address
*copyc ame$improper_file_id
*copyc cle$ecc_connected_file
*copyc amt$call_block
*copyc amt$display_tft_options
*copyc amt$fap_layer_number
*copyc amt$fap_pointer
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc bat$display_tables_indention
*copyc clt$display_control
*copyc ost$caller_identifier
*copyc ost$status
*copyc pft$usage_options
*copyc pft$usage_selections
?? POP ??
*copyc amp$access_method
*copyc amp$put_next
*copyc bap$display_tft_entry
*copyc bap$validate_file_identifier
*copyc clp$convert_str_to_path_handle
*copyc clp$get_fs_path_string
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc pmp$get_task_cp_time
*copyc amv$access_level_names
*copyc amv$block_type_names
*copyc amv$file_organization_names
*copyc amv$record_type_names
*copyc amv$usage_option_names
*copyc bav$file_positions
*copyc bav$request_name_table_ptr
*copyc bav$task_file_table
*copyc bav$tft_entry_assignment

  PROCEDURE [XREF] bap$fetch_trace_control
    (VAR trace_file_open: boolean;
     VAR trace_file_id: amt$file_identifier);

  PROCEDURE [XREF] bap$store_trace_control
    (    trace_file_open: boolean;
         trace_file_id: amt$file_identifier);

?? TITLE := 'setup_trace', EJECT ??

  PROCEDURE [INLINE] setup_trace
    (    file_identifier: amt$file_identifier;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    CONST
      trace_file = ':$LOCAL.$AM_TRACE.1';

    VAR
      ba: amt$file_byte_address,
      evaluated_file_reference: fst$evaluated_file_reference,
      file_instance: ^bat$task_file_entry,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      path_handle_name: fst$path_handle_name,
      trace_file_attachment_options: array [1 .. 5] of fst$attachment_option,
      trace_file_open: boolean,
      file_id_is_valid: boolean;

    status.normal := TRUE;

    bap$validate_file_identifier (file_identifier, file_instance, file_id_is_valid);
    IF NOT file_id_is_valid THEN
      osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, 'AMM$TRACE_ROUTINES', status);
      RETURN; {----->
    IFEND;

    bap$fetch_trace_control (trace_file_open, trace_file_id);

    IF NOT trace_file_open THEN

      clp$convert_str_to_path_handle (trace_file, {delete_allowed=} TRUE, {resolve_path=} TRUE,
            {include_open_position=} FALSE, path_handle_name, evaluated_file_reference, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF file_instance^.local_file_name = path_handle_name THEN
        osp$set_status_abnormal (amc$access_method_id, cle$circular_file_connection,
              file_instance^.local_file_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, file_instance^.local_file_name, status);
        RETURN; {----->
      IFEND;

      trace_file_attachment_options [1].selector := fsc$access_and_share_modes;
      trace_file_attachment_options [1].access_modes.selector := fsc$specific_access_modes;
      trace_file_attachment_options [1].access_modes.value := $fst$file_access_options
            [fsc$read, fsc$shorten, fsc$append, fsc$modify, fsc$execute];
      trace_file_attachment_options [1].share_modes.selector := fsc$specific_share_modes;
      trace_file_attachment_options [1].share_modes.value := $fst$file_access_options [];
      trace_file_attachment_options [2].selector := fsc$open_share_modes;
      trace_file_attachment_options [2].open_share_modes := $fst$file_access_options
            [fsc$read, fsc$shorten, fsc$append, fsc$modify, fsc$execute];
      trace_file_attachment_options [3].selector := fsc$sequential_access;
      trace_file_attachment_options [3].sequential_access := TRUE;
      trace_file_attachment_options [4].selector := fsc$delete_data;
      trace_file_attachment_options [4].delete_data := FALSE;
      trace_file_attachment_options [5].selector := fsc$open_position;
      trace_file_attachment_options [5].open_position := amc$open_at_eoi;

      fsp$open_file (trace_file, amc$record, ^trace_file_attachment_options, NIL, NIL, NIL, NIL,
            trace_file_id, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      trace_file_open := TRUE;
      bap$store_trace_control (trace_file_open, trace_file_id);

    IFEND;

  PROCEND setup_trace;

?? TITLE := 'close_trace', EJECT ??

  PROCEDURE [INLINE] close_trace
    (VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      trace_file_open: boolean;

    status.normal := TRUE;

    trace_file_open := FALSE;
    bap$store_trace_control (trace_file_open, trace_file_id);
    fsp$close_file (trace_file_id, status);

  PROCEND close_trace;


?? TITLE := '  amp$full_table_eep_trace', EJECT ??

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

    VAR
      ignore_status: ost$status,
      trace_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      caller_id: ost$caller_identifier,
      trace_file_open: boolean,
      trace_file_id: amt$file_identifier;

    #CALLER_ID (caller_id);

    setup_trace (file_identifier, trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      RETURN; {----->
    IFEND;

    output_status (trace_file_id, status, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    bap$display_tft_entry (trace_file_id, file_identifier, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    close_trace (trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

  PROCEND amp$full_table_eep_trace;

?? TITLE := 'amp$full_table_fap_trace', EJECT ??

  PROCEDURE [XDCL, #GATE] amp$full_table_fap_trace
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      trace_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      caller_id: ost$caller_identifier,
      trace_file_id: amt$file_identifier;

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

    setup_trace (file_identifier, trace_file_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    output_initial_line (file_identifier, call_block.operation, caller_id.ring, 2 {indent} , trace_file_id,
          trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      output_status (trace_file_id, status, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

    output_operation_info (call_block, file_identifier, 6 {indent} , trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    IF call_block.operation <> amc$close_req THEN
      bap$display_tft_entry (trace_file_id, file_identifier, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

    IF (call_block.operation = amc$close_req) OR (NOT status.normal) OR (NOT trace_status.normal) THEN
      close_trace (trace_file_id, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

  PROCEND amp$full_table_fap_trace;
?? TITLE := 'amp$trace_calls', EJECT ??

  PROCEDURE [XDCL, #GATE] amp$trace_calls
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      trace_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      caller_id: ost$caller_identifier,
      trace_file_id: amt$file_identifier;

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

    setup_trace (file_identifier, trace_file_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    output_initial_line (file_identifier, call_block.operation, caller_id.ring, 2 {indent} , trace_file_id,
          trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      output_status (trace_file_id, status, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

    IF (call_block.operation = amc$close_req) OR (NOT status.normal) OR (NOT trace_status.normal) THEN
      close_trace (trace_file_id, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

  PROCEND amp$trace_calls;

?? TITLE := 'amp$trace_call_blocks', EJECT ??

  PROCEDURE [XDCL, #GATE] amp$trace_call_blocks
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      trace_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      caller_id: ost$caller_identifier,
      trace_file_id: amt$file_identifier;

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

    setup_trace (file_identifier, trace_file_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    output_initial_line (file_identifier, call_block.operation, caller_id.ring, 2 {indent} , trace_file_id,
          trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      output_status (trace_file_id, status, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

    output_operation_info (call_block, file_identifier, 6 {indent} , trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    IF (call_block.operation = amc$close_req) OR (NOT status.normal) OR (NOT trace_status.normal) THEN
      close_trace (trace_file_id, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

  PROCEND amp$trace_call_blocks;

?? TITLE := 'amp$trace_timings', EJECT ??

  PROCEDURE [XDCL, #GATE] amp$trace_timings
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      trace_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      caller_id: ost$caller_identifier,
      start_time: pmt$task_cp_time,
      stop_time: pmt$task_cp_time,
      trace_file_id: amt$file_identifier;

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

    setup_trace (file_identifier, trace_file_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    output_initial_line (file_identifier, call_block.operation, caller_id.ring, 2 {indent} , trace_file_id,
          trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    pmp$get_task_cp_time (start_time, ignore_status);
    amp$access_method (file_identifier, call_block, layer_number, status);
    pmp$get_task_cp_time (stop_time, ignore_status);
    IF NOT status.normal THEN
      output_status (trace_file_id, status, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

    output_operation_info (call_block, file_identifier, 6 {indent} , trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    output_timing_info (start_time, stop_time, 6 {indent} , trace_file_id, trace_status);
    IF NOT trace_status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
    IFEND;

    IF (call_block.operation = amc$close_req) OR (NOT status.normal) THEN
      close_trace (trace_file_id, trace_status);
      IF NOT trace_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], trace_status, ignore_status);
      IFEND;
    IFEND;

  PROCEND amp$trace_timings;

?? TITLE := 'PROCEDURE output_status', EJECT ??

  PROCEDURE output_status
    (    output_fid: amt$file_identifier;
         message_status: ost$status;
     VAR status: ost$status);

    VAR
      ba: amt$file_byte_address,
      j: integer,
      line_count: ^ost$status_message_line_count,
      line_length: ^ost$status_message_line_size,
      line_text: ^string ( * ),
      message: ost$status_message,
      p_message: ^ost$status_message;

    status.normal := TRUE;

    osp$format_message (message_status, osc$full_message_level, 78, message, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    p_message := ^message;
    RESET p_message;

    NEXT line_count IN p_message;
    FOR j := 1 TO line_count^ DO
      NEXT line_length IN p_message;
      NEXT line_text: [line_length^] IN p_message;
      amp$put_next (output_fid, line_text, line_length^, ba, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND output_status;

?? TITLE := 'output_operation_info', EJECT ??

  PROCEDURE output_operation_info
    (    call_block: amt$call_block;
         file_identifier: amt$file_identifier;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address;

    status.normal := TRUE;

    CASE call_block.operation OF
    = amc$get_segment_pointer_req =
      output_segment_info (call_block.getsegp.segment_pointer^, amc$get_segment_pointer_req, indent + 4,
            trace_file_id, status);
    = amc$open_req =
      IF call_block.open.existing_file THEN
        STRINGREP (output_string, output_length, ' ': indent, 'OPEN OLD FILE');
        amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      ELSE
        STRINGREP (output_string, output_length, ' ': indent, 'OPEN NEW FILE');
        amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
      output_instance_of_open_info (file_identifier, indent, trace_file_id, status);
    = amc$set_segment_eoi_req =
      output_segment_info (call_block.segeoi.segment_pointer, amc$set_segment_eoi_req, indent + 4,
            trace_file_id, status);
    = amc$set_segment_position_req =
      output_segment_info (call_block.segpos.segment_pointer, amc$set_segment_position_req, indent + 4,
            trace_file_id, status);
    = amc$skip_req =
      output_skip_info (call_block.skp, indent, trace_file_id, status);
    = amc$get_direct_req, amc$get_key_req, amc$get_next_req .. amc$get_partial_req, amc$put_direct_req,
          amc$put_key_req, amc$put_next_req .. amc$putrep_req =
      output_working_storage (call_block, indent, trace_file_id, status);
      output_tc_and_fp (call_block, indent, trace_file_id, status);
      output_byte_address (call_block, indent, trace_file_id, status);
      output_term_option (call_block, indent, trace_file_id, status);
    ELSE
    CASEND;

  PROCEND output_operation_info;

?? TITLE := 'output_segment_info', EJECT ??

  PROCEDURE output_segment_info
    (    pointer: amt$segment_pointer;
         operation: amt$fap_operation;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      cell_pointer: ^cell,
      length: 6 .. 14,
      limit: ost$segment_length,
      position: ost$segment_length,
      segment_pointer_kind: [READ, STATIC, oss$job_paged_literal] array [amt$pointer_kind] of string (11) :=
            ['^CELL      ', '^HEAP ( * )', '^SEQ ( * ) '],
      segment_pointer: string (14);

    status.normal := TRUE;

    CASE pointer.kind OF
    = amc$cell_pointer =
      cell_pointer := pointer.cell_pointer;
      position := #OFFSET (cell_pointer);
    = amc$heap_pointer =
      cell_pointer := pointer.heap_pointer;
    = amc$sequence_pointer =
      cell_pointer := pointer.sequence_pointer;
      position := i#current_sequence_position (pointer.sequence_pointer);
    ELSE
    CASEND;

    STRINGREP (output_string, output_length, ' ': indent - 4, segment_pointer_kind [pointer.kind], ' : ',
          cell_pointer);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF pointer.kind <> amc$heap_pointer THEN
      IF operation = amc$set_segment_eoi_req THEN
        STRINGREP (output_string, output_length, ' ': indent, 'segment eoi : ', position);
        amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      ELSE
        STRINGREP (output_string, output_length, ' ': indent, 'segment position : ', position);
        amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
    IFEND;

    IF pointer.kind <> amc$cell_pointer THEN
      IF pointer.kind = amc$heap_pointer THEN
        limit := #SIZE (pointer.heap_pointer^);
      ELSE
        limit := #SIZE (pointer.sequence_pointer^);
      IFEND;
      STRINGREP (output_string, output_length, ' ': indent, 'segment limit : ', limit);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IFEND;

  PROCEND output_segment_info;

?? TITLE := 'output_initial_line', EJECT ??

  PROCEDURE output_initial_line
    (    file_identifier: amt$file_identifier;
         operation: amt$fap_operation;
         ring_number: ost$valid_ring;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      ba: amt$file_byte_address,
      local_status: ost$status,
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      path: fst$path,
      path_handle: fmt$path_handle,
      path_size: fst$path_size;

    status.normal := TRUE;

    clp$get_fs_path_string (bav$task_file_table^ [file_identifier.ordinal].local_file_name, path, path_size,
          path_handle, local_status);

    STRINGREP (output_string, output_length, ' ': indent, bav$request_name_table_ptr^ [operation].name,
          ' issued from ring ', ring_number);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, '  for : ', path (1, path_size));
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_initial_line;

?? TITLE := ' PROCEDURE append_usage_selections ', EJECT ??

  PROCEDURE append_usage_selections
    (    access_or_share_modes: pft$usage_selections;
     VAR str: {i/o} string (bat$display_tables_str_length);
     VAR str_length: {i/o} integer);

    VAR
      usage_option: pft$usage_options;

    IF access_or_share_modes = $pft$usage_selections [] THEN
      STRINGREP (str, str_length, str (1, str_length), 'NONE');
    ELSE
      STRINGREP (str, str_length, str (1, str_length), '(');
      FOR usage_option := LOWERVALUE (pft$usage_options) TO UPPERVALUE (pft$usage_options) DO
        IF usage_option IN access_or_share_modes THEN
          STRINGREP (str, str_length, str (1, str_length), amv$usage_option_names [usage_option].
                name (1, amv$usage_option_names [usage_option].size));
          STRINGREP (str, str_length, str (1, str_length), ', ');
        IFEND;
      FOREND;
      str_length := str_length - 1;
      str (str_length) := ')';
    IFEND;

  PROCEND append_usage_selections;

?? TITLE := 'output_instance_of_open_info', EJECT ??

  PROCEDURE output_instance_of_open_info
    (    file_identifier: amt$file_identifier;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    CONST
      error_text = 'INVALID';

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      file_instance: ^bat$task_file_entry,
      ignore_status: ost$status,
      valid_fid: boolean;

    status.normal := TRUE;
    bap$validate_file_identifier (file_identifier, file_instance, valid_fid);

    IF valid_fid THEN

      STRINGREP (output_string, output_length, ' ': indent, 'Access_level : ',
            amv$access_level_names [file_instance^.access_level].name);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      STRINGREP (output_string, output_length, ' ': indent, 'File_organization : ',
            amv$file_organization_names [file_instance^.instance_attributes.static_label.file_organization].
            name);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      STRINGREP (output_string, output_length, ' ': indent, 'Block_type : ',
            amv$block_type_names [file_instance^.instance_attributes.static_label.block_type].name);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      STRINGREP (output_string, output_length, ' ': indent, 'Record_type : ',
            amv$record_type_names [file_instance^.instance_attributes.static_label.record_type].name);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      STRINGREP (output_string, output_length, ' ': indent, 'Access_mode : ');
      append_usage_selections (file_instance^.instance_attributes.dynamic_label.access_mode, output_string,
            output_length);
      amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

    IFEND; {IF valid_fid}

  PROCEND output_instance_of_open_info;

?? TITLE := 'output_working_storage', EJECT ??

  PROCEDURE output_working_storage
    (    call_block: amt$call_block;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      wsa: ^cell,
      wsl: amt$working_storage_length;

    status.normal := TRUE;
    CASE call_block.operation OF
    = amc$get_direct_req =
      wsa := call_block.getd.working_storage_area;
      wsl := call_block.getd.working_storage_length;
    = amc$get_key_req =
      wsa := call_block.getk.working_storage_area;
      wsl := call_block.getk.working_storage_length;
    = amc$get_next_req =
      wsa := call_block.getn.working_storage_area;
      wsl := call_block.getn.working_storage_length;
    = amc$get_next_key_req =
      wsa := call_block.getnk.working_storage_area;
      wsl := call_block.getnk.working_storage_length;
    = amc$get_partial_req =
      wsa := call_block.getp.working_storage_area;
      wsl := call_block.getp.working_storage_length;
    = amc$put_direct_req =
      wsa := call_block.putd.working_storage_area;
      wsl := call_block.putd.working_storage_length;
    = amc$put_key_req =
      wsa := call_block.putk.working_storage_area;
      wsl := call_block.putk.working_storage_length;
    = amc$put_next_req =
      wsa := call_block.putn.working_storage_area;
      wsl := call_block.putn.working_storage_length;
    = amc$put_partial_req =
      wsa := call_block.putp.working_storage_area;
      wsl := call_block.putp.working_storage_length;
    = amc$putrep_req =
      wsa := call_block.putrep.working_storage_area;
      wsl := call_block.putrep.working_storage_length;
    = amc$replace_req =
      wsa := call_block.replace.working_storage_area;
      wsl := call_block.replace.working_storage_length;
    = amc$replace_direct_req =
      wsa := call_block.repld.working_storage_area;
      wsl := call_block.repld.working_storage_length;
    = amc$replace_key_req =
      wsa := call_block.repk.working_storage_area;
      wsl := call_block.repk.working_storage_length;
    ELSE
      RETURN; {----->
    CASEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Working storage area : ', wsa);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Working_storage_length : ', wsl);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_working_storage;

?? TITLE := 'output_tc_and_fp', EJECT ??

  PROCEDURE output_tc_and_fp
    (    call_block: amt$call_block;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      fp: ^amt$file_position,
      tc: ^amt$transfer_count;


    status.normal := TRUE;

    CASE call_block.operation OF
    = amc$get_direct_req =
      tc := call_block.getd.transfer_count;
      fp := call_block.getd.file_position;
    = amc$get_next_req =
      tc := call_block.getn.transfer_count;
      fp := call_block.getn.file_position;
    = amc$get_partial_req =
      tc := call_block.getp.transfer_count;
      fp := call_block.getp.file_position;
    ELSE
      RETURN; {----->
    CASEND;

    STRINGREP (output_string, output_length, ' ': indent, 'File_position : ', bav$file_positions [fp^]);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Transfer_count : ', tc^);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_tc_and_fp;


?? TITLE := 'output_byte_address', EJECT ??

  PROCEDURE output_byte_address
    (    call_block: amt$call_block;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      byte_address: amt$file_byte_address;

    status.normal := TRUE;

    CASE call_block.operation OF
    = amc$get_direct_req =
      byte_address := call_block.getd.byte_address;
    = amc$get_next_req =
      byte_address := call_block.getn.byte_address^;
    = amc$get_partial_req =
      byte_address := call_block.getp.byte_address^;
    = amc$put_direct_req =
      byte_address := call_block.putd.byte_address;
    = amc$put_next_req =
      byte_address := call_block.putn.byte_address^;
    = amc$put_partial_req =
      byte_address := call_block.putp.byte_address^;
    = amc$replace_direct_req =
      byte_address := call_block.repld.byte_address;
    ELSE
      RETURN; {----->
    CASEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Byte_address : ', byte_address, '(10)   ',
          byte_address: #(16), '(16)');
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_byte_address;

?? TITLE := 'output_term_option', EJECT ??

  PROCEDURE output_term_option
    (    call_block: amt$call_block;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      skip_options: [READ, oss$job_paged_literal] array [amt$skip_option] of string (7) := ['to_eor ',
            'no_skip'],
      term_options: [READ, oss$job_paged_literal] array [amt$term_option] of string (9) := ['start    ',
            'continue ', 'terminate'],
      term_text: string (9);

    status.normal := TRUE;

    CASE call_block.operation OF
    = amc$put_partial_req =
      IF (call_block.putp.term_option < LOWERVALUE (amt$term_option)) OR
            (call_block.putp.term_option > UPPERVALUE (amt$term_option)) THEN
        term_text := 'INVALID  ';
      ELSE
        term_text := term_options [call_block.putp.term_option];
      IFEND;
      STRINGREP (output_string, output_length, ' ': indent, 'Term_option : ', term_text);
    = amc$get_partial_req =
      IF (call_block.getp.skip_option < LOWERVALUE (amt$skip_option)) OR
            (call_block.getp.skip_option > UPPERVALUE (amt$skip_option)) THEN
        term_text := 'INVALID  ';
      ELSE
        term_text := skip_options [call_block.getp.skip_option];
      IFEND;
      STRINGREP (output_string, output_length, ' ': indent, 'Skip_option : ', term_text);
    ELSE
      RETURN; {----->
    CASEND;

    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_term_option;

?? TITLE := 'output_skip_info', EJECT ??

  PROCEDURE output_skip_info
    (    skip: amt$skip_req;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      count: amt$skip_count,
      direction: string (8),
      unit: string (9);

    status.normal := TRUE;

    IF skip.direction = amc$forward THEN
      direction := 'forward';
    ELSEIF skip.direction = amc$backward THEN
      direction := 'backward';
    ELSE
      direction := 'INVALID';
    IFEND;
    IF skip.unit = amc$skip_record THEN
      unit := 'record';
    ELSEIF skip.unit = amc$skip_partition THEN
      unit := 'partition';
    ELSE
      unit := 'INVALID';
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Skip_direction : ', direction);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Skip_count : ', skip.count);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Skip_unit : ', unit);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'File_position : ',
          bav$file_positions [skip.file_position^]);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_skip_info;

?? TITLE := 'output_timing_info', EJECT ??

  PROCEDURE output_timing_info
    (    start_time: pmt$task_cp_time;
         stop_time: pmt$task_cp_time;
         indent: bat$display_tables_indention;
     VAR trace_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      output_length: integer,
      output_string: string (bat$display_tables_str_length),
      ba: amt$file_byte_address,
      elapsed_time: pmt$task_cp_time,
      message: ost$status,
      elpased_time: pmt$task_cp_time;

    status.normal := TRUE;

    elapsed_time.task_time := stop_time.task_time - start_time.task_time;
    elapsed_time.monitor_time := stop_time.monitor_time - start_time.monitor_time;

    STRINGREP (output_string, output_length, ' ': indent, 'Starting task time    = ', start_time.task_time);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Starting monitor time = ',
          start_time.monitor_time);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Elapsed task time     = ', elapsed_time.task_time);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    STRINGREP (output_string, output_length, ' ': indent, 'Elapsed monitor time  = ',
          elapsed_time.monitor_time);
    amp$put_next (trace_file_id, ^output_string, output_length, ba, status);

  PROCEND output_timing_info;

MODEND amm$trace_routines;

