?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Code Utilities: Process Linker Debug Tables' ??
MODULE ocm$process_linker_debug_tables;


{ PURPOSE:
{   This module contains the routines to open, search, and close a linker debug table.

{   **** ANY CHANGES TO THIS DECK MUST ALSO CHANGE OCM$PROCESS_LNKR_DBG_TBLS_OCU IN OCU ****


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc oce$ve_linker_exceptions
*copyc oss$job_fixed
*copyc oss$mainframe_pageable
?? POP ??
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osv$mainframe_pageable_heap

*copyc pmt$linker_debug_table_header
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
?? EJECT ??

  CONST
    c$system_debug_tables = 'Current System';

  VAR
    ocv$address_entry_points: [oss$mainframe_pageable] ^array [1 .. * ] of pmt$number_of_debug_items,
    ocv$debug_table_header: [oss$mainframe_pageable] ^pmt$linker_debug_table_header := NIL,
    ocv$debug_table_segment: [oss$mainframe_pageable] ^SEQ ( * );

  VAR
    v$debug_table_header: [oss$job_fixed] ^pmt$linker_debug_table_header := NIL,
    v$debug_table_segment: [oss$job_fixed] ^SEQ ( * );

?? OLDTITLE ??
?? NEWTITLE := 'determine_section_name', EJECT ??

{ PURPOSE:
{   Set the section name to the name explicitly given to the section or to
{   a name determined by the segment type.

  PROCEDURE determine_section_name
    (    section_item: pmt$section_item;
     VAR section_name: pmt$program_name);


    IF (section_item.name <> osc$null_name) THEN
      section_name := section_item.name;
    ELSEIF (section_item.kind = llc$code_section) THEN
      section_name := 'CODE SECTION';
    ELSEIF (section_item.kind = llc$binding_section) THEN
      section_name := 'BINDING SECTION';
    ELSEIF (section_item.segment_access_control.read_privilege <> osc$non_readable) AND
          (section_item.segment_access_control.write_privilege <> osc$non_writable) THEN
      section_name := 'READ WRITE';
    ELSEIF (section_item.segment_access_control.read_privilege <> osc$non_readable) THEN
      section_name := 'READ ONLY';
    ELSE
      section_name := 'WORKING STORAGE';
    IFEND;


  PROCEND determine_section_name;
?? OLDTITLE ??
?? NEWTITLE := 'find_entry_point_item', EJECT ??

{ PURPOSE:
{   Search for the given entry_point in the entry point tables.  A binary
{   search can be made as the entry_point table is sorted.

  PROCEDURE find_entry_point_item
    (    entry_point_name: pmt$program_name;
     VAR found: boolean;
     VAR entry_point_item: pmt$entry_point_item);


    VAR
      temp: integer,
      entry_points: ^pmt$entry_point_items,
      lower: pmt$number_of_debug_items,
      upper: pmt$number_of_debug_items,
      mid: pmt$number_of_debug_items;


    found := FALSE;

    IF v$debug_table_header^.number_of_entry_points = 0 THEN
      RETURN;
    IFEND;

    entry_points := #PTR (v$debug_table_header^.entry_point_items, v$debug_table_segment^);


    lower := LOWERBOUND (entry_points^);
    upper := UPPERBOUND (entry_points^);

    WHILE (lower <= upper) DO
      temp := lower + upper;
      mid := temp DIV 2;
      IF (entry_points^ [mid].name = entry_point_name) THEN
        entry_point_item := entry_points^ [mid];
        found := TRUE;
        RETURN;
      ELSEIF (entry_points^ [mid].name < entry_point_name) THEN
        lower := mid + 1;
      ELSE
        upper := mid - 1;
      IFEND;
    WHILEND;


  PROCEND find_entry_point_item;
?? OLDTITLE ??
?? NEWTITLE := 'find_entry_point_via_address', EJECT ??

{ PURPOSE:
{   Search the entry point table for the entry point that matches the specified
{   address.
{
{ NOTE:
{   Entry point index is the index of the entry point corresponding to the
{   address.  If this index is unknown, then 1 should be specified which will
{   cause a search of the beginning of the table.

  PROCEDURE find_entry_point_via_address
    (    address: pmt$segment_and_offset;
         entry_point_index: pmt$number_of_debug_items;
     VAR entry_point_item: pmt$entry_point_item);


    VAR
      entry_points: ^pmt$entry_point_items,
      index: pmt$number_of_debug_items;


    entry_points := #PTR (v$debug_table_header^.entry_point_items, v$debug_table_segment^);

    FOR index := entry_point_index TO UPPERBOUND (entry_points^) DO
      IF (entry_points^ [index].address = address) THEN
        entry_point_item := entry_points^ [index];
        RETURN;
      IFEND;
    FOREND;

  PROCEND find_entry_point_via_address;
?? OLDTITLE ??
?? NEWTITLE := 'find_nearest_address_item', EJECT ??

{ PURPOSE:
{   This routine scans the address items table for the nearest item that
{   is less than or equal to the given address.  This search is done using
{   a binary search as the table is sorted by address.
{
{ NOTE:
{   When ever address_item.from_an_entry_point is TRUE, the variable
{   entry_point_index must be non-zero.  If the address_entry_point table
{   is not for this address table (because the job is in a job template),
{   then the value 1 must be returned for entry_point_index which will cause
{   the entry point table to be scanned from the beginning.

  PROCEDURE find_nearest_address_item
    (    address: pmt$segment_and_offset;
     VAR found: boolean;
     VAR address_item: pmt$address_item;
     VAR entry_point_index: pmt$number_of_debug_items);


    VAR
      temp: integer,
      addresses: ^pmt$address_items,
      nearest: pmt$number_of_debug_items,
      lower: pmt$number_of_debug_items,
      upper: pmt$number_of_debug_items,
      mid: pmt$number_of_debug_items;


    found := FALSE;
    IF v$debug_table_header^.number_of_addresses = 0 THEN
      RETURN;
    IFEND;

    addresses := #PTR (v$debug_table_header^.address_items, v$debug_table_segment^);
    lower := LOWERBOUND (addresses^);
    upper := UPPERBOUND (addresses^);
    nearest := lower;

  /find_nearest_address/
    WHILE (lower <= upper) DO
      temp := lower + upper;
      mid := temp DIV 2;
      IF (addresses^ [mid].segment_offset = address) THEN
        nearest := mid;
        EXIT /find_nearest_address/;
      ELSEIF (addresses^ [mid].segment_offset < address) THEN
        nearest := mid;
        lower := mid + 1;
      ELSE
        upper := mid - 1;
      IFEND;
    WHILEND /find_nearest_address/;

    IF (address >= addresses^ [nearest].segment_offset) AND
          ((address DIV 100000000(16)) = (addresses^ [nearest].segment_offset DIV 100000000(16))) THEN
      found := TRUE;
      address_item := addresses^ [nearest];
      IF v$debug_table_segment = ocv$debug_table_segment THEN
        entry_point_index := ocv$address_entry_points^ [nearest];
        IF entry_point_index > 0 THEN
          address_item.from_an_entry_point := TRUE;
        IFEND;
      ELSE
        entry_point_index := 1;
      IFEND;
    IFEND;

  PROCEND find_nearest_address_item;
?? OLDTITLE ??
?? NEWTITLE := 'find_section_item', EJECT ??

{ PURPOSE:
{   This routine finds the section containing the specified address.

  PROCEDURE find_section_item
    (    address: pmt$segment_and_offset;
         module_item: ^pmt$module_item;
     VAR found: boolean;
     VAR section_item: llt$section_ordinal);


    VAR
      i: llt$section_ordinal;


    found := FALSE;

    FOR i := 0 TO UPPERBOUND (module_item^.section_item) DO
      IF (address >= module_item^.section_item [i].address) AND
            (address < (module_item^.section_item [i].address + module_item^.section_item [i].length)) THEN

        found := TRUE;
        section_item := i;

        RETURN;
      IFEND;
    FOREND;


  PROCEND find_section_item;
?? OLDTITLE ??
?? NEWTITLE := 'match_entry_points_to_addresses', EJECT ??

{ PURPOSE:
{   Build a parallel table to the address table which gives the index of the
{   entry point that corresponds to the address.

  PROCEDURE match_entry_points_to_addresses;


    VAR
      temp: integer,
      address: pmt$segment_and_offset,
      addresses: ^pmt$address_items,
      entry_points: ^pmt$entry_point_items,
      i: pmt$number_of_debug_items,
      lower: pmt$number_of_debug_items,
      upper: pmt$number_of_debug_items,
      mid: pmt$number_of_debug_items;


    IF v$debug_table_header^.number_of_addresses = 0 THEN
      RETURN;
    IFEND;

    addresses := #PTR (v$debug_table_header^.address_items, v$debug_table_segment^);

    ALLOCATE ocv$address_entry_points: [1 .. UPPERBOUND (addresses^)] IN osv$mainframe_pageable_heap^;

    FOR i := 1 TO UPPERBOUND (addresses^) DO
      ocv$address_entry_points^ [i] := 0;
    FOREND;

    IF v$debug_table_header^.number_of_entry_points = 0 THEN
      RETURN;
    IFEND;

    entry_points := #PTR (v$debug_table_header^.entry_point_items, v$debug_table_segment^);

    FOR i := 1 TO UPPERBOUND (entry_points^) DO
      address := entry_points^ [i].address;
      lower := LOWERBOUND (addresses^);
      upper := UPPERBOUND (addresses^);

    /find_address_in_table/
      WHILE (lower <= upper) DO
        temp := lower + upper;
        mid := temp DIV 2;
        IF (addresses^ [mid].segment_offset = address) THEN
          ocv$address_entry_points^ [mid] := i;
          EXIT /find_address_in_table/;
        ELSEIF (addresses^ [mid].segment_offset < address) THEN
          lower := mid + 1;
        ELSE
          upper := mid - 1;
        IFEND;
      WHILEND /find_address_in_table/;

    FOREND;

  PROCEND match_entry_points_to_addresses;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$define_linker_debug_table', EJECT ??

{ PURPOSE:
{   This routine sets the debug table to the specified value.

  PROCEDURE [XDCL, #GATE] ocp$define_linker_debug_table
    (    sequence_pointer: ^SEQ ( * );
     VAR status: ost$status);



    VAR
      ignore_status: ost$status;


    status.normal := TRUE;

    IF sequence_pointer = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_eof_on_debug_file, c$system_debug_tables, status);
      RETURN;
    IFEND;

    v$debug_table_segment := sequence_pointer;
    RESET v$debug_table_segment;

    NEXT v$debug_table_header IN v$debug_table_segment;
    IF v$debug_table_header = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_eof_on_debug_file, c$system_debug_tables, status);
      RETURN;
    IFEND;

    IF v$debug_table_header^.version <> pmc$linker_debug_table_version THEN
      osp$set_status_abnormal ('OC', oce$e_invalid_debug_tbl_version, c$system_debug_tables, status);
      RETURN;
    IFEND;

    IF ocv$debug_table_header = NIL THEN
      ocv$debug_table_header := v$debug_table_header;
      ocv$debug_table_segment := v$debug_table_segment;
      match_entry_points_to_addresses;
    IFEND;


  PROCEND ocp$define_linker_debug_table;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$find_debug_address', EJECT ??

{ PURPOSE:
{   This routine returns the module name, section name, and offset within
{   the section for the specified address.

  PROCEDURE [XDCL, #GATE] ocp$find_debug_address
    (    segment: ost$segment;
         offset: ost$segment_offset;
     VAR found: boolean;
     VAR module_name: pmt$program_name;
     VAR section_name: pmt$program_name;
     VAR offset_in_section: ost$segment_offset;
     VAR status: ost$status);


    VAR
      address: pmt$segment_and_offset,
      address_item: pmt$address_item,
      entry_point_index: pmt$number_of_debug_items,
      entry_point_item: pmt$entry_point_item,
      module_item: ^pmt$module_item,
      section_item: llt$section_ordinal;


    status.normal := TRUE;
    found := FALSE;

    IF v$debug_table_header = NIL THEN
      IF ocv$debug_table_header = NIL THEN
        osp$set_status_condition (oce$e_debug_table_not_open, status);
        RETURN;
      IFEND;
      v$debug_table_header := ocv$debug_table_header;
      v$debug_table_segment := ocv$debug_table_segment;
    IFEND;

    address := (segment * 100000000(16)) + offset;
    find_nearest_address_item (address, found, address_item, entry_point_index);

    IF found THEN
      module_item := #PTR (address_item.module_item, v$debug_table_segment^);
      module_name := module_item^.identification.name;

      find_section_item (address, module_item, found, section_item);

      IF found THEN
        IF address_item.from_an_entry_point THEN
          find_entry_point_via_address (address_item.segment_offset, entry_point_index, entry_point_item);
          section_name := entry_point_item.name;
          offset_in_section := address - entry_point_item.address;
        ELSE
          determine_section_name (module_item^.section_item [section_item], section_name);
          offset_in_section := address - module_item^.section_item [section_item].address;
        IFEND;
      IFEND;
    IFEND;


  PROCEND ocp$find_debug_address;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$find_debug_entry_point', EJECT ??

{ PURPOSE:
{   This routine returns the address and the name of the containing
{   module for the specified entry point.

  PROCEDURE [XDCL, #GATE] ocp$find_debug_entry_point
    (    entry_point: pmt$program_name;
     VAR found: boolean;
     VAR module_name: pmt$program_name;
     VAR segment: ost$segment;
     VAR offset: ost$segment_offset;
     VAR status: ost$status);


    VAR
      entry_point_index: pmt$number_of_debug_items,
      entry_point_item: pmt$entry_point_item,
      module_item: ^pmt$module_item,
      address_item: pmt$address_item,
      module_found: boolean;


    status.normal := TRUE;
    found := FALSE;

    IF v$debug_table_header = NIL THEN
      IF ocv$debug_table_header = NIL THEN
        osp$set_status_condition (oce$e_debug_table_not_open, status);
        RETURN;
      IFEND;
      v$debug_table_header := ocv$debug_table_header;
      v$debug_table_segment := ocv$debug_table_segment;
    IFEND;

    find_entry_point_item (entry_point, found, entry_point_item);
    IF found THEN
      segment := entry_point_item.address DIV 100000000(16);
      offset := entry_point_item.address MOD 100000000(16);

      find_nearest_address_item (entry_point_item.address, module_found, address_item, entry_point_index);
      IF module_found THEN
        module_item := #PTR (address_item.module_item, v$debug_table_segment^);
        module_name := module_item^.identification.name;
      ELSE
        module_name := osc$null_name;
      IFEND;
    IFEND;


  PROCEND ocp$find_debug_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$find_debug_module_item', EJECT ??

{ PURPOSE:
{   This routine returns the module information for the specified module.

  PROCEDURE [XDCL, #GATE] ocp$find_debug_module_item
    (    name: pmt$program_name;
         occurrence: pmt$number_of_debug_items;
     VAR found: boolean;
     VAR module_item: ^pmt$module_item;
     VAR status: ost$status);


    VAR
      i: pmt$number_of_debug_items,
      count: pmt$number_of_debug_items,
      item_pointer: ^ REL (pmt$adaptable_sequence) ^pmt$module_item;


    status.normal := TRUE;
    found := FALSE;

    IF v$debug_table_header = NIL THEN
      IF ocv$debug_table_header = NIL THEN
        osp$set_status_condition (oce$e_debug_table_not_open, status);
        RETURN;
      IFEND;
      v$debug_table_header := ocv$debug_table_header;
      v$debug_table_segment := ocv$debug_table_segment;
    IFEND;

    count := 0;

    item_pointer := ^v$debug_table_header^.first_module_address_table_item;

    FOR i := 1 TO v$debug_table_header^.number_of_modules DO
      module_item := #PTR (item_pointer^, v$debug_table_segment^);

      IF module_item^.identification.name = name THEN
        count := count + 1;
        IF count >= occurrence THEN
          found := TRUE;
          RETURN;
        IFEND;
      IFEND;

      item_pointer := ^module_item^.next_module;
    FOREND;


  PROCEND ocp$find_debug_module_item;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$get_debug_table_header', EJECT ??

{ PURPOSE:
{   This routine returns the header of the currently defined debug table.

  PROCEDURE [XDCL, #GATE] ocp$get_debug_table_header
    (VAR debug_table_header: ^pmt$linker_debug_table_header;
     VAR status: ost$status);


    IF v$debug_table_header = NIL THEN
      IF ocv$debug_table_header = NIL THEN
        osp$set_status_condition (oce$e_debug_table_not_open, status);
        RETURN;
      IFEND;
      v$debug_table_header := ocv$debug_table_header;
      v$debug_table_segment := ocv$debug_table_segment;
    IFEND;

    debug_table_header := v$debug_table_header;


  PROCEND ocp$get_debug_table_header;
?? OLDTITLE ??

MODEND ocm$process_linker_debug_tables;
