MODULE osm$heap_manager_helpers_2dd;
?? RIGHT := 110 ??

{ Module purpose.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ofe$error_codes
*copyc ose$undefined_condition
*copyc ost$halfword
*copyc ost$status
?? POP ??
*copyc fip#addl_initialize
*copyc fip#addl_inject
*copyc fip#addl_integer
*copyc fip#addl_rjinteger
*copyc fip#addl_string

*copyc avp$configuration_administrator
*copyc avp$system_displays
*copyc avp$system_operator
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$trimmed_string_size
*copyc osp$establish_block_exit_hndlr
*copyc osp$generate_heap_map_r3
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc clv$nil_display_control
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] OSP$DISPLAY_HEAP_MAP', EJECT ??

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

{ PROCEDURE display_heap_map (
{   heap, h: key
{       (mainframe_wired_heap, mwh, mainframe_wired, mw)
{       (mainframe_wired_cb_heap, mwch, mainframe_wired_cb, mwc)
{       (mainframe_pageable_heap, mph, mainframe_pageable, mp)
{       (network_wired_heap, network_wired, nwh, nw)
{       (network_paged_heap, nph, network_paged, np)
{       (job_fixed_heap, jfh, job_fixed, jf)
{       (job_pageable_heap, job_pageable, jph, jp)
{       (task_private_heap, task_private, tph, tp)
{       (task_shared_heap, task_shared, tsh, ts)
{     keyend = $required
{   output, o: file = $output
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 36] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [105, 9, 7, 14, 27, 36, 268],
    clc$command, 5, 3, 1, 0, 0, 0, 3, ''], [
    ['H                              ',clc$abbreviation_entry, 1],
    ['HEAP                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ 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, 1339,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [4, 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$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [5, 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$keyword_type], [36], [
    ['JF                             ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
    ['JFH                            ', clc$alias_entry, clc$normal_usage_entry, 6],
    ['JOB_FIXED                      ', clc$alias_entry, clc$normal_usage_entry, 6],
    ['JOB_FIXED_HEAP                 ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['JOB_PAGEABLE                   ', clc$alias_entry, clc$normal_usage_entry, 7],
    ['JOB_PAGEABLE_HEAP              ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['JP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 7],
    ['JPH                            ', clc$alias_entry, clc$normal_usage_entry, 7],
    ['MAINFRAME_PAGEABLE             ', clc$alias_entry, clc$normal_usage_entry, 3],
    ['MAINFRAME_PAGEABLE_HEAP        ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['MAINFRAME_WIRED                ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['MAINFRAME_WIRED_CB             ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['MAINFRAME_WIRED_CB_HEAP        ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MAINFRAME_WIRED_HEAP           ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['MP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['MPH                            ', clc$alias_entry, clc$normal_usage_entry, 3],
    ['MW                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['MWC                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['MWCH                           ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['MWH                            ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['NETWORK_PAGED                  ', clc$alias_entry, clc$normal_usage_entry, 5],
    ['NETWORK_PAGED_HEAP             ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['NETWORK_WIRED                  ', clc$alias_entry, clc$normal_usage_entry, 4],
    ['NETWORK_WIRED_HEAP             ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['NP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
    ['NPH                            ', clc$alias_entry, clc$normal_usage_entry, 5],
    ['NW                             ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['NWH                            ', clc$alias_entry, clc$normal_usage_entry, 4],
    ['TASK_PRIVATE                   ', clc$alias_entry, clc$normal_usage_entry, 8],
    ['TASK_PRIVATE_HEAP              ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['TASK_SHARED                    ', clc$alias_entry, clc$normal_usage_entry, 9],
    ['TASK_SHARED_HEAP               ', clc$nominal_entry, clc$normal_usage_entry, 9],
    ['TP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 8],
    ['TPH                            ', clc$alias_entry, clc$normal_usage_entry, 8],
    ['TS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 9],
    ['TSH                            ', clc$alias_entry, clc$normal_usage_entry, 9]]
    ],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$heap = 1,
      p$output = 2,
      p$status = 3;

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

*copy clv$display_variables

    VAR
      busy_size_statistic_total: integer,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      free_size_statistic_total: integer,
      heap_map: ost$heap_map,
      heap_segment: ost$segment,
      i: integer,
      str: ost$string;

?? 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
        ignore_status: ost$status;

      clp$close_display (display_control, ignore_status);

    PROCEND abort_handler;

*copy clp$new_page_procedure
*copy clp$put_path_reference_subtitle
?? TITLE := 'put_subtitle ', EJECT ??

    PROCEDURE [INLINE] put_subtitle
      (VAR display_control: clt$display_control;
       VAR status: ost$status);

      VAR
        str: string (80),
        i: integer;

      clv$subtitles_built := FALSE;
      STRINGREP (str, i, 'Heap MAP for ', pvt [p$heap].value^.keyword_value);
      clp$put_partial_display (display_control, str (1, i), clc$trim, amc$terminate, status);

    PROCEND put_subtitle;
?? OLDTITLE ??
?? NEWTITLE := 'P$PUT_DISPLAY', EJECT ??

    PROCEDURE [INLINE] p$put_display
      (    str: string ( * ));

      VAR
        status: ost$status;

      clp$put_display (display_control, str, clc$trim, status);
      IF NOT status.normal THEN
        EXIT osp$display_heap_map; {----->
      IFEND;

    PROCEND p$put_display;
?? OLDTITLE ??
?? EJECT ??

    IF NOT (avp$system_operator () OR avp$configuration_administrator () OR avp$system_displays ()) THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active,
            'system_displays, system_operation, configuration_administration', status);
      RETURN; {----->
    IFEND;

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

    IF pvt [p$heap].value^.keyword_value = 'MAINFRAME_WIRED_HEAP   ' THEN
      heap_segment := osc$segnum_mainframe_wired;
    ELSEIF pvt [p$heap].value^.keyword_value = 'MAINFRAME_WIRED_CB_HEAP' THEN
      heap_segment := osc$segnum_mainframe_wired_cb;
    ELSEIF pvt [p$heap].value^.keyword_value = 'MAINFRAME_PAGEABLE_HEAP' THEN
      heap_segment := osc$segnum_mainframe_paged;
    ELSEIF pvt [p$heap].value^.keyword_value = 'NETWORK_WIRED_HEAP     ' THEN
      heap_segment := osc$segnum_task_private_ring_11;
    ELSEIF pvt [p$heap].value^.keyword_value = 'NETWORK_PAGED_HEAP     ' THEN
      heap_segment := 15;
    ELSEIF pvt [p$heap].value^.keyword_value = 'JOB_FIXED_HEAP         ' THEN
      heap_segment := osc$segnum_job_fixed_heap;
    ELSEIF pvt [p$heap].value^.keyword_value = 'JOB_PAGEABLE_HEAP      ' THEN
      heap_segment := osc$segnum_job_pageable_heap;
    ELSEIF pvt [p$heap].value^.keyword_value = 'TASK_PRIVATE_HEAP      ' THEN
      heap_segment := osc$segnum_task_private_heap;
    ELSEIF pvt [p$heap].value^.keyword_value = 'TASK_SHARED_HEAP       ' THEN
      heap_segment := osc$segnum_task_shared_heap;
    ELSE
      osp$set_status_condition (ose$undefined_condition, status);
      RETURN; {----->
    IFEND;

    osp$generate_heap_map_r3 (heap_segment, heap_map, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^abort_handler);

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);
    clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clv$titles_built := FALSE;
    clv$command_name := 'DISPLAY_HEAP_MAP';

    IF display_control.page_width < clc$narrow_page_width THEN
      clv$page_width := clc$narrow_page_width;
    ELSEIF display_control.page_width > clc$wide_page_width THEN
      clv$page_width := clc$wide_page_width;
    ELSE
      clv$page_width := display_control.page_width;
    IFEND;

{Status
    fip#addl_initialize (str, 'Status              : ');
    CASE heap_map.status OF
    = osc$heap_allocation_id_invalid =
      fip#addl_string (str, 'Allocation-ID Invalid');
    = osc$heap_free_valid =
      fip#addl_string (str, 'Heap Valid');
    = osc$heap_linkage_invalid =
      fip#addl_string (str, 'Linkage Invalid');
    = osc$heap_pointer_invalid =
      fip#addl_string (str, 'Pointer Invalid');
    = osc$heap_verification_failure =
      fip#addl_string (str, 'Heap Verification Failure');
    ELSE
      fip#addl_string (str, 'Unknown Status');
    CASEND;
    p$put_display (str.value (1, str.size));

{Algotithm
    fip#addl_initialize (str, 'Algotithm           : ');
    CASE heap_map.algorithm OF
    = 0 =
      fip#addl_string (str, 'Traps Enabled Algorithm - for Catalogs');
    = 1 =
      fip#addl_string (str, 'OS Heap Algorithm');
    = 2 =
      fip#addl_string (str, 'NAM/VE Algorithm');
    ELSE
      fip#addl_string (str, 'Unsupported Algorithm');
    CASEND;
    IF heap_map.avoid_small_blocks THEN
      fip#addl_string (str, ' - Honor Small Block Attributes');
    ELSE
      fip#addl_string (str, ' - Ignore Small Block Attributes');
    IFEND;
    p$put_display (str.value (1, str.size));

{Min_Fragment_Size
    fip#addl_initialize (str, 'Min Fragment Size   : ');
    fip#addl_rjinteger (str, heap_map.min_fragment_size, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Min_Allocation_Size
    fip#addl_initialize (str, 'Min Allocation Size : ');
    fip#addl_rjinteger (str, heap_map.min_allocation_size, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Small_Block_Ceiling
    fip#addl_initialize (str, 'Small Block Ceiling : ');
    fip#addl_rjinteger (str, heap_map.small_block_ceiling, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Allocate_Call_Count
    fip#addl_initialize (str, 'Allocate Call Count : ');
    fip#addl_rjinteger (str, heap_map.allocate_call_count, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Free_Call_Count
    fip#addl_initialize (str, 'Free Call Count     : ');
    fip#addl_rjinteger (str, heap_map.free_call_count, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Chain_Search_Count
    fip#addl_initialize (str, 'Chain Search Count  : ');
    fip#addl_rjinteger (str, heap_map.chain_search_count, 15, ' ', status);
    p$put_display (str.value (1, str.size));

{Fragment Statistics
    p$put_display ('');

    fip#addl_initialize (str, '');
    fip#addl_inject (str, 'Busy', 34);
    fip#addl_inject (str, 'Free', 54);
    p$put_display (str.value (1, str.size));
    p$put_display ('');

    fip#addl_initialize (str, 'Size Total');
    fip#addl_inject (str, ' ', 19);
    fip#addl_rjinteger (str, heap_map.busy_size_total, 18, ' ', status);
    fip#addl_inject (str, ' ', 39);
    fip#addl_rjinteger (str, heap_map.free_size_total, 18, ' ', status);
    p$put_display (str.value (1, str.size));

    fip#addl_initialize (str, 'Size biggest Block');
    fip#addl_inject (str, ' ', 19);
    fip#addl_rjinteger (str, heap_map.busy_size_max, 18, ' ', status);
    fip#addl_inject (str, ' ', 39);
    fip#addl_rjinteger (str, heap_map.free_size_max, 18, ' ', status);
    p$put_display (str.value (1, str.size));
    p$put_display ('');

    free_size_statistic_total := 0;
    busy_size_statistic_total := 0;

{Individual Blocks
    FOR i := 0 TO 1024 DO
      fip#addl_initialize (str, 'Block Count ');
      fip#addl_rjinteger (str, i, 6, ' ', status);

      IF (heap_map.busy_size_statistic [i] <> 0) OR (heap_map.free_size_statistic [i] <> 0) THEN
        fip#addl_inject (str, ' ', 19);
        fip#addl_rjinteger (str, heap_map.busy_size_statistic [i], 18, ' ', status);

        fip#addl_inject (str, ' ', 39);
        fip#addl_rjinteger (str, heap_map.free_size_statistic [i], 18, ' ', status);

        p$put_display (str.value (1, str.size));

        free_size_statistic_total := free_size_statistic_total + heap_map.free_size_statistic [i];
        busy_size_statistic_total := busy_size_statistic_total + heap_map.busy_size_statistic [i];
      IFEND;
    FOREND;

{Big Blocks
    fip#addl_initialize (str, 'Block Count >=1024');
    IF (heap_map.busy_size_statistic [1025] <> 0) OR (heap_map.free_size_statistic [1025] <> 0) THEN
      fip#addl_inject (str, ' ', 19);
      fip#addl_rjinteger (str, heap_map.busy_size_statistic [1025], 18, ' ', status);

      fip#addl_inject (str, ' ', 39);
      fip#addl_rjinteger (str, heap_map.free_size_statistic [1025], 18, ' ', status);

      p$put_display (str.value (1, str.size));
      free_size_statistic_total := free_size_statistic_total + heap_map.free_size_statistic [1025];
      busy_size_statistic_total := busy_size_statistic_total + heap_map.busy_size_statistic [1025];
    IFEND;

{Total:
    p$put_display ('---------------------------------------------------------');
    fip#addl_initialize (str, 'Total Blocks');
    fip#addl_inject (str, ' ', 19);
    fip#addl_rjinteger (str, busy_size_statistic_total, 18, ' ', status);

    fip#addl_inject (str, ' ', 39);
    fip#addl_rjinteger (str, free_size_statistic_total, 18, ' ', status);
    p$put_display (str.value (1, str.size));

    clp$close_display (display_control, status);

  PROCEND osp$display_heap_map;
?? OLDTITLE ??
MODEND osm$heap_manager_helpers_2dd;
