PROCEDURE dum$display_fat, display_fat, disfat (
  sfid, s: integer = $optional
  output, o: file = $output
  help, h: file = $null
  status)


  "$FORMAT=OFF"
  VAR
    when_status: status
  VAREND
  "$FORMAT=ON"

  WHEN any_fault DO
    when_status = $previous_status
    putl ' Invoked DISFAT condition handler due to the following abnormal status:'
    disv when_status
    putl ' Enter commands, "exit_proc" to abort, or "exit_proc with when_status" to abort with status'
    include_file command prompt='disfat_ch'
  WHENEND

  IF $specified(help) THEN
COLLECT_TEXT o=help until='HELPEND'
DISPLAY_FAT or DISFAT

  This procedure will display a file allocation table and describe the
contents of selected fields of the table.  This procedure assumes the
user has previously selected the correct exchange package by available
analyze_dump commands.

PARAMETERS:

SFID, S: integer
  This parameter specifies the SFID of the file to be displayed.  This
parameter is required.

OUTPUT, O: file
  This parameter selects the file name to receive the data.  This para-
meter is defaulted to $output.  If a file name other than $output is
entered the data will be formated correctly for printer disposition and
will be sent to the file  "$asis".

STATUS

WARNINGS/KNOWN DEFICIENCIES:
 None.

ERROR HANDLER
  When any fatal error is encountered a condition handler is invoked and
the following messages will appear:
 "Invoked DISFAT condition handler due to the following abnormal status:"
 "< the error status message >"
 "Enter commands, "exit_proc" to abort, or "exit_proc with when_status"
  to abort with status"
To exit the handler enter:    "exit_proc"
To exit the handler with status, enter:   "exit_proc with when_status"

HELPEND
    EXIT_PROC
  IFEND

  IF NOT $specified(sfid) THEN
    EXIT_PROC WITH $status(false, 'US', 4, 'Parameter SFID is required')
  IFEND

  "$FORMAT=OFF"
  VAR
    output_file: file

" The following constants are found in the deck GFC$CONSTANTS.

    gfc$fde_table_base: integer = $mem($sa(gfv$fde_table_base) 8)
    gfc$fde_size: integer = $mem($sa(gfv$fde_size) 8)

    fid_index: integer = sfid/10000(16)
    fid_file_residence: integer = (sfid - fid_index*10000(16))/100(16)
    fid_file_hash: integer = $mod(sfid, 100(16))

    current_fde_entry: integer
    disk_file_descriptor_p: integer
    fat_offset: integer
    p_fat: integer
    pfau: integer
    pftr: integer
    segment: integer

" The following offsets were obtained from the output of the command Display_Symbol_Table
" for the type DMT$FILE_ALLOCATION_UNIT.

    dau_address_offset: integer = 0
    state_offset: integer = 3
    fmd_index_offset: integer = 4

    dmt$fau_states: array 0..5 of string 1..$max_name = ('dmc$fau_free', 'dmc$fau_invalid_data', ..
          'dmc$fau_invalid_and_flawed', 'dmc$fau_initialized', 'dmc$fau_initialized_and_flawed', ..
          'dmc$fau_initialization_in_prog')

" The following offsets were obtained from the output of the command Display_Symbol_Table
" for the type DMT$DISK_FILE_DESCRIPTOR.

    p_fat_offset: integer = 0a(16)
    fat_upper_bound_offset: integer = 10(16)
    bytes_per_lev_2_offset: integer = 19(16)
    bytes_per_alloc_offset: integer = 7(16)

" The following offset was obtained from the output of the command Display_Symbol_Table
" for the type GFT$FILE_DESCRIPTOR_ENTRY.

    disk_file_descriptor_p_offset: integer = 60(16)
  VAREND
  "$FORMAT=ON"

  IF $file(output open_position) = '$BOI' THEN
    output_file = output.$asis
  ELSE
    output_file = output
  IFEND

"IF output = :$local.$output THEN
  put_line '1FILE ALLOCATION TABLE  SFID = '//$strrep(sfid, 16)//'(16)' o=output_file
"IFEND

  putl '  ' o=output_file

"Find the FDE so that info about the FAT can be found."

  IF fid_file_residence <> 1 THEN
    pftr = 300000000(16) "Use job tables (in job fixed)"
    segment = 300000000(16)
  ELSE
    pftr = 100000000(16) "Use system tables (in mainframe wired)"
    segment = 100000000(16)
  IFEND
  pftr = pftr + gfc$fde_table_base

  current_fde_entry = pftr + (fid_index * gfc$fde_size)
  disk_file_descriptor_p = $memory(current_fde_entry+disk_file_descriptor_p_offset, 4) + segment

" Now capture the FAT INFO."

  p_fat = $mem(disk_file_descriptor_p+p_fat_offset, 6)
  fat_upper_bound = $mem(disk_file_descriptor_p+fat_upper_bound_offset, 2)
  bytes_per_level_2 = $mem(disk_file_descriptor_p+bytes_per_lev_2_offset, 6)
  bytes_per_allocation = $mem(disk_file_descriptor_p+bytes_per_alloc_offset, 3)
  level_2_upperbound = bytes_per_level_2 / bytes_per_allocation - 1

" Now display the FAT."

  FOR i = 0 TO fat_upper_bound DO
    fat_offset = $mem(p_fat, 6)
    putl ' '//$strrep(i, 16)//' Offset = '//$strrep(i*bytes_per_level_2, 16)//'(16)' output=output_file
    putl '  fat offset = '//$strrep(fat_offset, 16)//'(16)' output=output_file
    IF fat_offset <> 0 THEN
      pfau = fat_offset + segment
      p_fat = p_fat + 6
      FOR j = 0 TO level_2_upperbound DO
        putl '   dau address = '//$strrep($mem(pfau+dau_address_offset, 3), 16)//'(16)' output=output_file
        putl '     fau_state = '//dmt$fau_states($mem(pfau+state_offset, 1)) o=output_file
        putl '     fad index = '//$strrep($mem(pfau+fmd_index_offset, 1), 16)//'(16)' output=output_file
        pfau = pfau + 5
      FOREND
    IFEND
  FOREND

PROCEND dum$display_fat
