?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Code Utilities: Process Lnkr Dbg Tbls OCU' ??
MODULE ocm$process_lnkr_dbg_tbls_ocu;


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

{   **** ANY CHANGES HERE MUST ALSO CHANGE OCM$PROCESS_LINKER_DEBUG_TABLES IN OS ****

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oce$ve_linker_exceptions
?? POP ??
*copyc amp$get_segment_pointer
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition

  VAR
    osv$debug_table: [XREF] ^SEQ ( * );

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

*copyc pmt$linker_debug_table_header

  CONST
    c$in_code = TRUE,
    c$code_or_data = FALSE,
    c$maximum_debug_tables = 5,
    c$system_debug_tables = 'Running System';

  VAR
    v$current_debug_table: integer,
    v$debug_table_header: array [1 .. c$maximum_debug_tables] of ^pmt$linker_debug_table_header :=
          [REP c$maximum_debug_tables of NIL],
    v$debug_table_id: array [1 .. c$maximum_debug_tables] of amt$file_identifier,
    v$debug_table_segment: array [1 .. c$maximum_debug_tables] of ^SEQ ( * ),
    v$number_of_dt_in_use: 0 .. c$maximum_debug_tables := 0,
    v$address_entry_points: array [1 .. c$maximum_debug_tables] of ^array [1 .. * ] of
          pmt$number_of_debug_items,
    v$system_debug_table: array [1 .. c$maximum_debug_tables] of boolean;

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

{ PURPOSE:
{   Create a section name from the attributes if no name is present.

  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 := 'fetch_addresses', EJECT ??

{ PURPOSE:
{   Return a pointer to the address table.

  PROCEDURE [INLINE] fetch_addresses
    (    code_only: boolean;
         index: 1 .. c$maximum_debug_tables;
     VAR addresses: ^pmt$address_items);


    IF (v$debug_table_header [index]^.number_of_addresses = 0) THEN
      addresses := NIL;
      RETURN;
    IFEND;
    addresses := #PTR (v$debug_table_header [index]^.address_items, v$debug_table_segment [index]^);

  PROCEND fetch_addresses;
?? OLDTITLE ??
?? NEWTITLE := 'find_debug_address', EJECT ??

{ PURPOSE:
{   Return the entry point/module section closest to the specified address.

  PROCEDURE find_debug_address
    (    segment: ost$segment;
         offset: ost$segment_offset;
         code_only: boolean;
     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,
      code_section: boolean,
      entry_point_item: pmt$entry_point_item,
      module_item: ^pmt$module_item,
      section_item: llt$section_ordinal;


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

    IF v$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
      RETURN;
    IFEND;

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

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

      find_section_item (address, module_item, found, section_item);

      IF found THEN
        code_section := (module_item^.section_item [section_item].kind = llc$code_section);
        IF NOT code_section AND code_only THEN
          found := FALSE;
          RETURN;
        IFEND;
        IF address_item.from_an_entry_point THEN
          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 find_debug_address;
?? OLDTITLE ??
?? NEWTITLE := 'find_entry_point_item', EJECT ??

{ PURPOSE:
{   Scan the entry point list of the debug tables looking for the specified
{   entry point name.

  PROCEDURE find_entry_point_item
    (    entry_point_name: pmt$program_name;
     VAR found: boolean;
     VAR entry_point_item: pmt$entry_point_item;
     VAR debug_segment: ^SEQ ( * ));

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


    found := FALSE;

  /debug_table_loop/
    FOR j := 1 TO v$number_of_dt_in_use DO
      IF v$debug_table_header [j]^.number_of_entry_points = 0 THEN
        CYCLE /debug_table_loop/;
      IFEND;

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


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

      WHILE (NOT found) AND (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;
          debug_segment := v$debug_table_segment [j];
          RETURN;
        ELSEIF (entry_points^ [mid].name < entry_point_name) THEN
          lower := mid + 1;
        ELSE
          upper := mid - 1;
        IFEND;
      WHILEND;
    FOREND /debug_table_loop/;

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

{ PURPOSE:
{   Search the address table for the item closest to but less then the given
{   address.

  PROCEDURE find_nearest_address_item
    (    address: pmt$segment_and_offset;
         code_only: boolean;
     VAR address_item: pmt$address_item;
     VAR entry_point_item: pmt$entry_point_item;
     VAR found: boolean);


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


    FOR j := 1 TO v$number_of_dt_in_use DO
      fetch_addresses (code_only, j, addresses);
      IF addresses = NIL THEN
        found := FALSE;
        RETURN;
      IFEND;

      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];
        v$current_debug_table := j;
        IF v$address_entry_points [j]^ [nearest] > 0 THEN
          entry_points := #PTR (v$debug_table_header [j]^.entry_point_items, v$debug_table_segment [j]^);
          entry_point_item := entry_points^ [v$address_entry_points [j]^ [nearest]];
          address_item.from_an_entry_point := TRUE;
        IFEND;
        RETURN;
      IFEND;

    FOREND;

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

{ PURPOSE:
{   Search the address table for the item closest to but less then the given
{   address and then locate the next item that is an entry point.

  PROCEDURE find_nearest_and_next_addr_item
    (    address: pmt$segment_and_offset;
         code_only: boolean;
     VAR address_item: pmt$address_item;
     VAR entry_point_item: pmt$entry_point_item;
     VAR found: boolean;
     VAR next_address_item: pmt$address_item;
     VAR next_entry_point_item: pmt$entry_point_item;
     VAR next_entry_point_found: boolean);


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


    next_entry_point_found := FALSE;

    FOR j := 1 TO v$number_of_dt_in_use DO
      fetch_addresses (code_only, j, addresses);
      IF addresses = NIL THEN
        found := FALSE;
        RETURN;
      IFEND;

      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];
        v$current_debug_table := j;
        IF v$address_entry_points [j]^ [nearest] > 0 THEN
          entry_points := #PTR (v$debug_table_header [j]^.entry_point_items, v$debug_table_segment [j]^);
          entry_point_item := entry_points^ [v$address_entry_points [j]^ [nearest]];
          address_item.from_an_entry_point := TRUE;
        IFEND;

        next_index  := nearest + 1;

      /find_next_address/
        WHILE (next_index <= UPPERBOUND (addresses^)) AND NOT next_entry_point_found DO

          IF (address < addresses^ [next_index].segment_offset) AND
                ((address DIV 100000000(16)) = (addresses^ [next_index].segment_offset DIV 100000000(16)))
                THEN
            IF v$address_entry_points [j]^ [next_index] > 0 THEN
              next_entry_point_found := TRUE;
              next_address_item := addresses^ [next_index];
              next_entry_point_item := entry_points^ [v$address_entry_points [j]^ [next_index]];
              next_address_item.from_an_entry_point := TRUE;
            ELSE
              next_index := next_index + 1;
            IFEND;
          ELSE
            RETURN;
          IFEND;
        WHILEND /find_next_address/;

        RETURN;
      IFEND;

    FOREND;

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

{ PURPOSE:
{   Find the section of the module 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
    (    debug_table: 1 .. c$maximum_debug_tables);


    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;


    fetch_addresses (FALSE, debug_table, addresses);
    IF addresses = NIL THEN
      RETURN;
    IFEND;

    ALLOCATE v$address_entry_points [debug_table]: [1 .. UPPERBOUND (addresses^)];

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

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

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

    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
          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/;
      v$address_entry_points [debug_table]^ [mid] := i;

    FOREND;

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

{ PURPOSE:
{   Close all the open linker debug tables and return any allocated memory.

  PROCEDURE [XDCL, #GATE] ocp$close_linker_debug_table
    (VAR status: ost$status);

    VAR
      j: integer;

    status.normal := TRUE;

    IF v$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
      RETURN;
    IFEND;

  /debug_table_loop/
    FOR j := 1 TO v$number_of_dt_in_use DO
      v$debug_table_header [j] := NIL;

      IF v$address_entry_points [j] <> NIL THEN
        FREE v$address_entry_points [j];
      IFEND;

      IF (v$system_debug_table [j]) THEN
        CYCLE /debug_table_loop/;
      IFEND;

      fsp$close_file (v$debug_table_id [j], status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND /debug_table_loop/;
    v$number_of_dt_in_use := 0

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

{ PURPOSE:
{   Add the specified debug table to the list of tables.

  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;

    IF v$number_of_dt_in_use >= c$maximum_debug_tables THEN
      osp$set_status_abnormal ('OC', oce$e_generate_status, 'Maximum of 5 open debug tables allowed', status);
      RETURN;
    IFEND;

    v$number_of_dt_in_use := v$number_of_dt_in_use + 1;

    v$system_debug_table [v$number_of_dt_in_use] := TRUE;
    v$address_entry_points [v$number_of_dt_in_use] := NIL;

    v$debug_table_segment [v$number_of_dt_in_use] := sequence_pointer;
    RESET v$debug_table_segment [v$number_of_dt_in_use];

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

    IF v$debug_table_header [v$number_of_dt_in_use]^.version <> pmc$linker_debug_table_version THEN
      v$debug_table_header [v$number_of_dt_in_use] := NIL;
      osp$set_status_abnormal ('OC', oce$e_invalid_debug_tbl_version, c$system_debug_tables, status);
      v$number_of_dt_in_use := v$number_of_dt_in_use - 1;
      RETURN;
    IFEND;

    match_entry_points_to_addresses (v$number_of_dt_in_use);


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

{ PURPOSE:
{   Return the entry point and offset from the entry point for an 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);


    status.normal := TRUE;

    find_debug_address (segment, offset, c$code_or_data, found, module_name, section_name, offset_in_section,
          status);

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

{ PURPOSE:
{   Return the entry point and offset from the entry point for an address.
{   The entry point returned will be in a code section.

  PROCEDURE [XDCL, #GATE] ocp$find_debug_address_in_code
    (    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);


    status.normal := TRUE;

    find_debug_address (segment, offset, c$in_code, found, module_name, section_name, offset_in_section,
          status);

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

{ PURPOSE:
{   Return the module, segment, and offset of an 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
      debug_segment: ^SEQ ( * ),
      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$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
      RETURN;
    IFEND;

    find_entry_point_item (entry_point, found, entry_point_item, debug_segment);
    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, FALSE, address_item, entry_point_item,
            module_found);
      IF module_found AND (entry_point_item.name = entry_point) THEN
        module_item := #PTR (address_item.module_item, debug_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_entry_pt_length', EJECT ??

{ PURPOSE:
{   Return the module, segment, and offset of an entry point and calculate
{   the length of the procedure.

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


    VAR
      address_item: pmt$address_item,
      debug_segment: ^SEQ ( * ),
      entry_point_item: pmt$entry_point_item,
      index: integer,
      module_found: boolean,
      module_item: ^pmt$module_item,
      module_length: ost$segment_length,
      module_offset: ost$segment_offset,
      next_address_item: pmt$address_item,
      next_entry_point_found: boolean,
      next_entry_point_item: pmt$entry_point_item,
      next_offset: ost$segment_offset;

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

    IF v$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
      RETURN;
    IFEND;

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

      find_nearest_and_next_addr_item (entry_point_item.address, FALSE, address_item, entry_point_item,
            module_found, next_address_item, next_entry_point_item, next_entry_point_found);
      IF module_found AND (entry_point_item.name = entry_point) THEN
        module_item := #PTR (address_item.module_item, debug_segment^);
        module_name := module_item^.identification.name;
        IF next_entry_point_found THEN
          next_offset := next_entry_point_item.address MOD 100000000(16);
          procedure_length := next_offset - offset;
        ELSE {entry_point was the last procedure in the module}
          FOR index := 0 TO UPPERBOUND (module_item^.section_item) DO
            IF (module_item^.section_item [index].kind = llc$code_section) THEN
              module_offset := module_item^.section_item [index].address MOD 100000000(16);
              module_length := module_item^.section_item [index].length;
              IF (offset >= module_offset) AND (offset <= module_offset + module_length - 1) THEN
                procedure_length := module_offset + module_length - offset;
                RETURN;
              IFEND;
            IFEND;
          FOREND;
{  Procedure length was not established.
          entry_point_found := FALSE;
        IFEND;
      ELSE
      IFEND;
    IFEND;

  PROCEND ocp$find_debug_entry_pt_length;

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

{ PURPOSE:
{   Return the module information on the nth occurrance of the module
{   in the debug tables.

  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,
      j: integer,
      count: pmt$number_of_debug_items,
      item_pointer: ^ REL (pmt$adaptable_sequence) ^pmt$module_item;


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

    IF v$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
      RETURN;
    IFEND;


    count := 0;
    FOR j := 1 TO v$number_of_dt_in_use DO
      item_pointer := ^v$debug_table_header [j]^.first_module_address_table_item;

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

        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;
    FOREND;

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

{ PURPOSE:
{   Return the debug table header.

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


    status.normal := TRUE;

    IF v$number_of_dt_in_use = 0 THEN
      osp$set_status_condition (oce$e_debug_table_not_open, status);
    ELSE
      debug_table_header := v$debug_table_header [v$number_of_dt_in_use];
    IFEND;

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

{ PURPOSE:
{   Open a debug table on a file.

  PROCEDURE [XDCL, #GATE] ocp$open_linker_debug_table
    (    debug_file_name: fst$file_reference;
     VAR status: ost$status);


    VAR
      ignore_status: ost$status,
      segment_pointer: amt$segment_pointer,
      read_attributes: [STATIC] array [1 .. 1] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, $fst$file_access_options [fsc$read]],
            [fsc$specific_share_modes, $fst$file_access_options [fsc$read, fsc$execute]]]];


    status.normal := TRUE;

    IF v$number_of_dt_in_use >= c$maximum_debug_tables THEN
      osp$set_status_abnormal ('OC', oce$e_generate_status, 'Maximum of 5 open debug tables allowed', status);
      RETURN;
    IFEND;

    v$number_of_dt_in_use := v$number_of_dt_in_use + 1;
    v$system_debug_table [v$number_of_dt_in_use] := FALSE;
    v$address_entry_points [v$number_of_dt_in_use] := NIL;

    fsp$open_file (debug_file_name, amc$segment, ^read_attributes, NIL, NIL, NIL, NIL,
          v$debug_table_id [v$number_of_dt_in_use], status);
    IF NOT status.normal THEN
      v$number_of_dt_in_use := v$number_of_dt_in_use - 1;
      RETURN;
    IFEND;

    amp$get_segment_pointer (v$debug_table_id [v$number_of_dt_in_use], amc$sequence_pointer, segment_pointer,
          status);
    IF NOT status.normal THEN
      v$number_of_dt_in_use := v$number_of_dt_in_use - 1;
      RETURN;
    IFEND;

    v$debug_table_segment [v$number_of_dt_in_use] := segment_pointer.sequence_pointer;
    RESET v$debug_table_segment [v$number_of_dt_in_use];

    NEXT v$debug_table_header [v$number_of_dt_in_use] IN v$debug_table_segment [v$number_of_dt_in_use];
    IF v$debug_table_header [v$number_of_dt_in_use] = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_eof_on_debug_file, debug_file_name, status);
      v$number_of_dt_in_use := v$number_of_dt_in_use - 1;
      RETURN;
    IFEND;

    IF v$debug_table_header [v$number_of_dt_in_use]^.version <> pmc$linker_debug_table_version THEN
      v$debug_table_header [v$number_of_dt_in_use] := NIL;
      osp$set_status_abnormal ('OC', oce$e_invalid_debug_tbl_version, debug_file_name, status);
      v$number_of_dt_in_use := v$number_of_dt_in_use - 1;
      RETURN;
    IFEND;

    match_entry_points_to_addresses (v$number_of_dt_in_use);

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

{ PURPOSE:
{   Open the debug table for the running system.

  PROCEDURE [XDCL, #GATE] ocp$open_running_debug_table
    (VAR status: ost$status);


    status.normal := TRUE;

    ocp$define_linker_debug_table (osv$debug_table, status);

  PROCEND ocp$open_running_debug_table;
?? OLDTITLE ??

MODEND ocm$process_lnkr_dbg_tbls_ocu;

