PROC dum$generate_heap_map, generate_heap_map, genhm (
  input, i: FILE = $OPTIONAL
  output, o: FILE = $OPTIONAL
  help: BOOLEAN = FALSE
  status)

  IF $value(help) THEN
    putl '0  GENERATE_HEAP_MAP  (GENHM)' o=$output
    putl '     input, i: FILE = $OPTIONAL' o=$output
    putl '     output, o: FILE = $OPTIONAL' o=$output
    putl '     help: BOOLEAN = FALSE' o=$output
    putl '     status)' o=$output
    putl '0    This procedure looks at an input file generated in a dump and prints out' o=$output
    putl '     the configuration of the heap: offset, length of the block, and whether' o=$output
    putl '     it is allocated or free.  It requires the use of a LEGIBLE, CONTINUOUS' o=$output
    putl '     file (SETFA <file_name> FC=LEGIBLE PF=CONTINUOUS); otherwise the offsets' o=$output
    putl '     will be screwed up by the page headers.' o=$output
    putl '0    The input and output files MUST be specified despite what the header says.' o=$output
    putl ' ' o=$output
    EXIT_PROC
  IFEND

  IF (NOT $specified(input)) OR (NOT $specified(output)) THEN
    disv '-- ERROR -- The parameters INPUT and OUTPUT must be specified despite what the procedure header says.' o=$output
    EXIT_PROC
  IFEND

  crev ignore_status k=status
  IF $file($value(input), file_contents) <> 'LEGIBLE' THEN
    disv 'ERROR -- The input file: '//$string($value(input))//' is not a legible file.' o=$value(output)
    put_line ' You cannot use this procedure until you remedy this problem.' o=$fname($string($value(output))//'.$EOI')
    status = $status(FALSE, 'PF', 000000, 'The input file is not a legible file.')
    EXIT_PROC WITH status
  IFEND
  crev (scratch_string_1, scratch_string_2, build_string, offset, new_line) k=string
  crev (converted_integer_length, converted_integer, new_offset) k=integer
  crev edit_status k=status
  edit_file f=$value(input) p=$null o=$null
    edit_status.normal = TRUE
    locate_text t='0021 3651' status=edit_status
    IF NOT edit_status.normal THEN
      quit no
      delv (scratch_string_1, scratch_string_2, build_string)
      delv (converted_integer_length, converted_integer)
      EXIT_PROC WITH edit_status
    IFEND
    position_cursor n=2 status=edit_status
    IF NOT edit_status.normal THEN
      quit no
      delv (scratch_string_1, scratch_string_2, build_string)
      delv (converted_integer_length, converted_integer)
      EXIT_PROC WITH edit_status
    IFEND
    WHEN any_fault DO
      quit no
      EXIT_PROC WITH $status(FALSE, 'PF', 000000, 'Condition handler activated.')
    WHENEND
    i = 1
    page = 1
    line = 1
    mem_column_1 = 66
    mem_column_2 = 71
    allocate_column = 78

" The following comments are the possible ways memory can be displayed by ANAD.  Substring references are determined by layout: ..
00000100  0123 4567 89AB CDEF   0123 4567 89AB CDEF   0123 4567 89AB CDEF   0123 4567 89AB CDEF ..
00000100   0123 4567 89AB CDEF   0123 4567 89AB CDEF   0123 4567 89AB CDEF   0123 4567 89AB CDEF

    scratch_string_1 = $line_text
    scratch_string_2 = '0'//$substr(scratch_string_1, mem_column_1, 4)//$substr(scratch_string_1, mem_column_2, 4)//'0'//'(16)'
    disv $integer(scratch_string_2) o=:$local.$null status=edit_status
    IF NOT edit_status.normal THEN
      mem_column_1 = 65
      mem_column_2 = 70
      allocate_column = 77
      edit_status.normal = TRUE
    IFEND

    WHILE edit_status.normal DO
      IF line = 1 THEN
        put_line '1Heap map generated from file '//$string($value(input))//'                     PAGE '//$strrep(page) ..
 o=$fname($string($value(output))//'.$EOI')
        page = page + 1
        line = 3
        put_line '0  OFFSET (16)   LENGTH(16)   BLOCK STATUS     OFFSET (16)   LENGTH(16)   BLOCK STATUS     OFFSET (16)   LENGTH(16)   BLOCK STATUS' o=$fname($string($value(output))//'.$EOI')
        line = 4
        put_line '   ' o=$fname($string($value(output))//'.$EOI')
        line = 5
      IFEND
      scratch_string_1 = $line_text
      IF i = 1 THEN
        build_string = '   '
      ELSE
        build_string = build_string//'       '
      IFEND
      offset = $substr(scratch_string_1, 1, 8)
      build_string = build_string//offset                                             "OFFSET"
      scratch_string_2 = '0'//$substr(scratch_string_1, mem_column_1, 4)//$substr(scratch_string_1, mem_column_2, 4)//'0'//'(16)'
      converted_integer = $integer(scratch_string_2)
      converted_integer_length = $strlen($strrep(converted_integer, 16))
      build_string = build_string//'          '
      build_string = build_string//$substr($strrep(converted_integer,16), 1, 10)      "LENGTH"
      new_offset = $integer(offset//'(16)') + converted_integer
      IF $substr(scratch_string_1, 78) = 'F' THEN
        build_string = build_string//'allocated'
      ELSE                                                                            "ALLOCATED/FREE"
        build_string = build_string//'     free'
      IFEND
      IF i = 3 THEN
        put_line build_string o=$fname($string($value(output))//'.$EOI')
        i = 1
        IF line = 60 THEN
          line = 1
        ELSE
          line = line + 1
        IFEND
      ELSE
        i = i + 1
      IFEND
      IF $strlen($strrep(new_offset)) = 1 THEN
        new_line = '0000000'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 2 THEN
        new_line = '000000'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 3 THEN
        new_line = '00000'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 4 THEN
        new_line = '0000'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 5 THEN
        new_line = '000'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 6 THEN
        new_line = '00'//$strrep(new_offset, 16)
      ELSEIF $strlen($strrep(new_offset)) = 7 THEN
        new_line = '0'//$strrep(new_offset, 16)
      ELSE "$strlen($strrep(new_offset)) = 8"
        new_line = $strrep(new_offset, 16)
      IFEND
      position_cursor t=new_line d=f status=edit_status
      IF NOT edit_status.normal THEN
        IF $condition(edit_status) = 'ESE$TEXT_NOT_FOUND' THEN
          edit_status = $status(FALSE, 'XX', 0, 'Not enough memory dumped to complete heap map generation. ..
You must dump as much of this segment as possible to the same input file, using file position $EOI.')
        IFEND
      IFEND
    WHILEND
  quit
  delv (scratch_string_1, scratch_string_2, build_string, new_line)
  delv (converted_integer_length, converted_integer, offset, new_offset)
  change_file_attributes f=$value(output) fc=list status=ignore_status
  EXIT_PROC WITH edit_status WHEN NOT edit_status.normal
  delv (edit_status ignore_status)

PROCEND dum$generate_heap_map
