?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Program Management - Debug Table Builder' ??
MODULE pmm$debug_table_builder;

{  PURPOSE:
{
{    This module is responsible for accumulating the debug table
{    information output by the loader and making it available to
{    the debugger.
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cyd$debug_symbols
*copyc dbt$entry_point_table
*copyc dbt$module_address_table_item
*copyc llt$line_address_table
*copyc llt$load_module
*copyc llt$supplemental_debug_tables
*copyc oce$library_generator_errors
*copyc osd$code_base_pointer
*copyc ose$heap_full_exceptions
*copyc oss$task_private
*copyc pme$debug_exceptions
*copyc pmt$debug_table_info
?? POP ??
*copyc clp$convert_integer_to_string
*copyc i#build_adaptable_array_ptr
*copyc i#build_adaptable_seq_pointer
*copyc mmp$create_segment
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pmp$exit
*copyc pmp$find_executing_task_tcb
*copyc osv$task_private_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declaration Declared by This Module', EJECT ??

  VAR
    current_debug_symbol_table: [STATIC, oss$task_private] ^pmt$debug_symbol_table_list,
    current_line_address_table: [STATIC, oss$task_private] ^pmt$line_address_table_list,
    current_supplemental_dtable: [STATIC, oss$task_private] ^pmt$supplemental_dtable_list,
    first_debug_symbol_table: [STATIC, oss$task_private] pmt$debug_symbol_table_list,
    first_line_address_table: [STATIC, oss$task_private] pmt$line_address_table_list,
    first_supplemental_dtable: [STATIC, oss$task_private] pmt$supplemental_dtable_list,
    number_of_debug_symbol_tables: [STATIC, oss$task_private] 0 .. llc$max_components,
    number_of_line_address_tables: [STATIC, oss$task_private] llt$line_address_table_size,
    number_of_supplemental_dtables: [STATIC, oss$task_private] 0 .. llc$max_components;

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

  PROCEDURE set_up_debug_table_processing;

    number_of_line_address_tables := 0;
    current_line_address_table := ^first_line_address_table;
    current_line_address_table^.link := NIL;

    number_of_debug_symbol_tables := 0;
    current_debug_symbol_table := ^first_debug_symbol_table;
    current_debug_symbol_table^.link := NIL;

    number_of_supplemental_dtables := 0;
    current_supplemental_dtable := ^first_supplemental_dtable;
    current_supplemental_dtable^.link := NIL;
  PROCEND set_up_debug_table_processing;
?? OLDTITLE ??
?? NEWTITLE := 'finish_line_table_processing', EJECT ??

  PROCEDURE finish_line_table_processing
    (VAR status: ost$status);

    VAR
      i: llt$line_address_table_size,
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    IF number_of_line_address_tables <> 0 THEN
      NEXT tcb_p^.nosve.debug_table^.current_module_item^.line_address_tables:
            [0 .. number_of_line_address_tables - 1] IN tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
      IF tcb_p^.nosve.debug_table^.current_module_item^.line_address_tables = NIL THEN
        osp$set_status_abnormal ('PM', pme$module_segment_overflow, '', status);
        RETURN;
      IFEND;

      current_line_address_table := ^first_line_address_table;
      FOR i := 0 TO (number_of_line_address_tables - 1) DO
        current_line_address_table := current_line_address_table^.link;
        tcb_p^.nosve.debug_table^.current_module_item^.line_address_tables^ [i] :=
              current_line_address_table^.pointer;
      FOREND;
    IFEND;
  PROCEND finish_line_table_processing;
?? OLDTITLE ??
?? NEWTITLE := 'finish_debug_table_processing', EJECT ??

  PROCEDURE finish_debug_table_processing
    (VAR status: ost$status);

    VAR
      i: 0 .. llc$max_components,
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    IF number_of_debug_symbol_tables > 0 THEN
      NEXT tcb_p^.nosve.debug_table^.current_module_item^.debug_symbol_tables:
            [0 .. number_of_debug_symbol_tables - 1] IN tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
      IF tcb_p^.nosve.debug_table^.current_module_item^.debug_symbol_tables = NIL THEN
        osp$set_status_abnormal ('PM', pme$module_segment_overflow, '', status);
        FOR i := 0 TO (number_of_debug_symbol_tables - 1) DO
          current_debug_symbol_table := first_debug_symbol_table.link;
          first_debug_symbol_table.link := current_debug_symbol_table^.link;
          FREE current_debug_symbol_table IN osv$task_private_heap^;
        FOREND;
      ELSE

        current_debug_symbol_table := ^first_debug_symbol_table;

        FOR i := 0 TO (number_of_debug_symbol_tables - 1) DO
          current_debug_symbol_table := current_debug_symbol_table^.link;
          tcb_p^.nosve.debug_table^.current_module_item^.debug_symbol_tables^ [i] :=
                current_debug_symbol_table^.pointer;
        FOREND;
      IFEND;
    IFEND;
  PROCEND finish_debug_table_processing;
?? OLDTITLE ??
?? NEWTITLE := 'finish_sd_table_processing', EJECT ??

  PROCEDURE finish_sd_table_processing
    (VAR status: ost$status);

    VAR
      i: 0 .. llc$max_components,
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    IF number_of_supplemental_dtables > 0 THEN
      NEXT tcb_p^.nosve.debug_table^.current_module_item^.supplemental_debug_tables:
            [0 .. number_of_supplemental_dtables - 1] IN tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
      IF tcb_p^.nosve.debug_table^.current_module_item^.supplemental_debug_tables = NIL THEN
        osp$set_status_abnormal ('PM', pme$module_segment_overflow, '', status);
        FOR i := 0 TO (number_of_supplemental_dtables - 1) DO
          current_supplemental_dtable := first_supplemental_dtable.link;
          first_supplemental_dtable.link := current_supplemental_dtable^.link;
          FREE current_supplemental_dtable IN osv$task_private_heap^;
        FOREND;
      ELSE

        current_supplemental_dtable := ^first_supplemental_dtable;

        FOR i := 0 TO (number_of_supplemental_dtables - 1) DO
          current_supplemental_dtable := current_supplemental_dtable^.link;
          tcb_p^.nosve.debug_table^.current_module_item^.supplemental_debug_tables^ [i] :=
                current_supplemental_dtable^.pointer;
        FOREND;
      IFEND;
    IFEND;
  PROCEND finish_sd_table_processing;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_module', EJECT ??
*copy dbh$define_module

  PROCEDURE [XDCL] dbp$define_module
    (    identification: ^llt$identification;
         language: llt$module_generator;
     VAR status: ost$status);

    VAR
      modules_ptr: ^llt$identification,
      ring_attributes: array [1 .. 1] of mmt$attribute_descriptor,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;
    PUSH modules_ptr;

    pmp$find_executing_task_tcb (tcb_p);
    IF tcb_p^.nosve.debug_table^.module_segment.seq_pointer = NIL THEN
      ring_attributes [1].keyword := mmc$kw_ring_numbers;
      ring_attributes [1].r1 := osc$tsrv_ring;
      ring_attributes [1].r2 := 0f(16);
      mmp$create_segment (^ring_attributes, mmc$sequence_pointer, 1, tcb_p^.nosve.debug_table^.module_segment,
            status);
      IF status.normal THEN
        RESET tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
        tcb_p^.nosve.debug_table^.last_module_item := ^tcb_p^.nosve.debug_table^.
              first_module_address_table_item;
      ELSE
        RETURN;
      IFEND;
    ELSE
      IF tcb_p^.nosve.debug_table^.current_module_item <> NIL THEN
        osp$set_status_abnormal ('PM', pme$missing_module_termination,
              tcb_p^.nosve.debug_table^.current_module_item^.name, status);
        dbp$terminate_module (status);
      IFEND;
    IFEND;

    modules_ptr^ := identification^;
    modules_ptr^.generator_id := language;
    NEXT tcb_p^.nosve.debug_table^.current_module_item: [0 .. modules_ptr^.greatest_section_ordinal] IN
          tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
    IF tcb_p^.nosve.debug_table^.current_module_item <> NIL THEN
      tcb_p^.nosve.debug_table^.current_module_item^.name := modules_ptr^.name;
      tcb_p^.nosve.debug_table^.current_module_item^.language := modules_ptr^.generator_id;
      tcb_p^.nosve.debug_table^.current_module_item^.greatest_section_ordinal :=
            modules_ptr^.greatest_section_ordinal;
      tcb_p^.nosve.debug_table^.current_module_item^.application_identifier := NIL;
      tcb_p^.nosve.debug_table^.current_module_item^.reinitialization_information := identification;
      tcb_p^.nosve.debug_table^.current_module_item^.next_module := NIL;
      tcb_p^.nosve.debug_table^.current_module_item^.line_address_tables := NIL;
      tcb_p^.nosve.debug_table^.current_module_item^.debug_symbol_tables := NIL;
      tcb_p^.nosve.debug_table^.current_module_item^.supplemental_debug_tables := NIL;

      set_up_debug_table_processing;
    ELSE
      osp$set_status_abnormal ('PM', pme$module_segment_overflow, '', status);
    IFEND;
  PROCEND dbp$define_module;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_section', EJECT ??
*copy dbh$define_section

  PROCEDURE [XDCL] dbp$define_section
    (    section_item: dbt$section_item;
     VAR status: ost$status);

    VAR
      dummy: ost$status,
      str: ost$string,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer <> NIL) AND
          (tcb_p^.nosve.debug_table^.current_module_item <> NIL) THEN
      IF section_item.section_ordinal <= UPPERBOUND (tcb_p^.nosve.debug_table^.current_module_item^.
            section_item) THEN
        tcb_p^.nosve.debug_table^.current_module_item^.section_item [section_item.section_ordinal] :=
              section_item;
      ELSE
        osp$set_status_abnormal ('PM', pme$invalid_section_ordinal,
              tcb_p^.nosve.debug_table^.current_module_item^.name, status);
        clp$convert_integer_to_string (section_item.section_ordinal, 10, FALSE, str, dummy);
        osp$append_status_parameter (osc$status_parameter_delimiter, str.value (1, str.size), status);
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
    IFEND;

  PROCEND dbp$define_section;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_applic_identifier', EJECT ??
*copy dbh$define_applic_identifier

  PROCEDURE [XDCL] dbp$define_applic_identifier
    (    application_identifier: ^llt$application_identifier;
     VAR status: ost$status);

    VAR
      dummy: ost$status,
      str: ost$string,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer <> NIL) AND
          (tcb_p^.nosve.debug_table^.current_module_item <> NIL) THEN
      NEXT tcb_p^.nosve.debug_table^.current_module_item^.application_identifier IN
            tcb_p^.nosve.debug_table^.module_segment.seq_pointer;
      IF tcb_p^.nosve.debug_table^.current_module_item^.application_identifier <> NIL THEN
        tcb_p^.nosve.debug_table^.current_module_item^.application_identifier^.name :=
              application_identifier^.name;
      ELSE
        osp$set_status_abnormal ('PM', pme$module_segment_overflow, '', status);
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
    IFEND;

  PROCEND dbp$define_applic_identifier;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_line_address_table', EJECT ??

  PROCEDURE [XDCL] dbp$define_line_address_table
    (    line_address_table: ^llt$line_address_table;
         loaded_ring: ost$ring;
     VAR status: ost$status);

    VAR
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer = NIL) OR
          (tcb_p^.nosve.debug_table^.current_module_item = NIL) THEN
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
      RETURN;
    IFEND;

    ALLOCATE current_line_address_table^.link IN osv$task_private_heap^;

    current_line_address_table := current_line_address_table^.link;
    current_line_address_table^.link := NIL;

    i#build_adaptable_array_ptr (loaded_ring, #SEGMENT (line_address_table), #OFFSET (line_address_table),
          #SIZE (line_address_table^.item), LOWERBOUND (line_address_table^.item),
          #SIZE (llt$line_address_item), #LOC (current_line_address_table^.pointer));

    number_of_line_address_tables := number_of_line_address_tables + 1;
  PROCEND dbp$define_line_address_table;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_debug_symbol_tables', EJECT ??

  PROCEDURE [XDCL] dbp$define_debug_symbol_tables
    (    debug_symbol_table: ^llt$symbol_table;
         loaded_ring: ost$ring;
     VAR status: ost$status);

    VAR
      symbol_table: ^SEQ ( * ),
      debug_table: ^llt$debug_symbol_table,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer = NIL) OR
          (tcb_p^.nosve.debug_table^.current_module_item = NIL) THEN
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
      RETURN;
    IFEND;

    IF debug_symbol_table = NIL THEN
      osp$set_status_abnormal ('PM', pme$bad_debug_symbol_table,
            tcb_p^.nosve.debug_table^.current_module_item^.name, status);
      RETURN;
    IFEND;

    ALLOCATE current_debug_symbol_table^.link IN osv$task_private_heap^;

    current_debug_symbol_table := current_debug_symbol_table^.link;
    current_debug_symbol_table^.link := NIL;

    symbol_table := ^debug_symbol_table^.text;
    RESET symbol_table;

    NEXT debug_table: [1 .. 1] IN symbol_table;
    IF debug_table = NIL THEN
      osp$set_status_abnormal ('PM', pme$bad_debug_symbol_table,
            tcb_p^.nosve.debug_table^.current_module_item^.name, status);
      RETURN;
    IFEND;

    RESET symbol_table;
    NEXT debug_table: [1 .. debug_table^.number_of_items] IN symbol_table;
    IF debug_table = NIL THEN
      osp$set_status_abnormal ('PM', pme$bad_debug_symbol_table,
            tcb_p^.nosve.debug_table^.current_module_item^.name, status);
      RETURN;
    IFEND;

    i#build_adaptable_array_ptr (loaded_ring, #SEGMENT (debug_table), #OFFSET (debug_table),
          #SIZE (debug_table^.item), LOWERBOUND (debug_table^.item), #SIZE (llt$symbol_table_item),
          #LOC (current_debug_symbol_table^.pointer));

    number_of_debug_symbol_tables := number_of_debug_symbol_tables + 1;
  PROCEND dbp$define_debug_symbol_tables;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_supplemental_dtables', EJECT ??
*copy dbh$define_supplemental_dtables

  PROCEDURE [XDCL] dbp$define_supplemental_dtables
    (    supplemental_debug_tables: ^llt$supplemental_debug_tables,
         loaded_ring: ost$ring;
     VAR status: ost$status);

    TYPE
      convert_pointer = record
        case boolean of
        = TRUE =
          value: ^llt$supplemental_debug_tables,
        = FALSE =
          sequence: ^SEQ ( * ),
        casend,
      recend;

    VAR
      convert_sequence_pointer: convert_pointer,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer = NIL) OR
          (tcb_p^.nosve.debug_table^.current_module_item = NIL) THEN
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
      RETURN;
    IFEND;

    ALLOCATE current_supplemental_dtable^.link IN osv$task_private_heap^;

    current_supplemental_dtable := current_supplemental_dtable^.link;
    current_supplemental_dtable^.link := NIL;

    i#build_adaptable_seq_pointer (loaded_ring, #SEGMENT (supplemental_debug_tables),
          #OFFSET (supplemental_debug_tables), #SIZE (supplemental_debug_tables^.sd_table), 0,
          convert_sequence_pointer.sequence);

    current_supplemental_dtable^.pointer := convert_sequence_pointer.value;

    number_of_supplemental_dtables := number_of_supplemental_dtables + 1;
  PROCEND dbp$define_supplemental_dtables;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$define_entry_point_address', EJECT ??
*copy dbh$define_entry_point_address

  PROCEDURE [XDCL] dbp$define_entry_point_address
    (    entry_point_table_item: dbt$entry_point_table_item;
     VAR status: ost$status);

    VAR
      ring_attributes: array [1 .. 1] of mmt$attribute_descriptor,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF tcb_p^.nosve.debug_table^.entry_point_segment.seq_pointer = NIL THEN
      ring_attributes [1].keyword := mmc$kw_ring_numbers;
      ring_attributes [1].r1 := osc$tsrv_ring;
      ring_attributes [1].r2 := 0f(16);
      mmp$create_segment (^ring_attributes, mmc$sequence_pointer, 1,
            tcb_p^.nosve.debug_table^.entry_point_segment, status);
      tcb_p^.nosve.debug_table^.number_of_entry_point_items := 1;
    ELSE
      IF tcb_p^.nosve.debug_table^.number_of_entry_point_items < dbc$max_entry_point_items THEN
        tcb_p^.nosve.debug_table^.number_of_entry_point_items :=
              tcb_p^.nosve.debug_table^.number_of_entry_point_items + 1;
      ELSE
        osp$set_status_abnormal ('PM', pme$too_many_entry_points, '', status);
      IFEND;
    IFEND;

    IF status.normal THEN
      RESET tcb_p^.nosve.debug_table^.entry_point_segment.seq_pointer;
      NEXT tcb_p^.nosve.debug_table^.entry_point_table: [1 .. tcb_p^.nosve.debug_table^.
            number_of_entry_point_items] IN tcb_p^.nosve.debug_table^.entry_point_segment.seq_pointer;
      IF tcb_p^.nosve.debug_table^.entry_point_table <> NIL THEN
        tcb_p^.nosve.debug_table^.entry_point_table^.address :=
              ^tcb_p^.nosve.debug_table^.entry_point_table^.item;
        tcb_p^.nosve.debug_table^.entry_point_table^.item [tcb_p^.nosve.debug_table^.
              number_of_entry_point_items] := entry_point_table_item;
      ELSE
        osp$set_status_abnormal ('PM', pme$entry_pt_segment_overflow, '', status);
      IFEND;
    IFEND;
  PROCEND dbp$define_entry_point_address;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] dbp$terminate_module', EJECT ??
*copy dbh$terminate_module

  PROCEDURE [XDCL] dbp$terminate_module
    (VAR status: ost$status);

    VAR
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb_p);
    IF (tcb_p^.nosve.debug_table^.module_segment.seq_pointer <> NIL) AND
          (tcb_p^.nosve.debug_table^.current_module_item <> NIL) THEN
      finish_line_table_processing (status);
      finish_debug_table_processing (status);
      finish_sd_table_processing (status);

      tcb_p^.nosve.debug_table^.last_module_item^ := tcb_p^.nosve.debug_table^.current_module_item;
      tcb_p^.nosve.debug_table^.last_module_item := ^tcb_p^.nosve.debug_table^.last_module_item^^.next_module;
      tcb_p^.nosve.debug_table^.current_module_item := NIL;
    ELSE
      osp$set_status_abnormal ('PM', pme$missing_module_definition, '', status);
    IFEND;
  PROCEND dbp$terminate_module;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] dbp$module_table_address', EJECT ??
*copy dbh$module_table_address

  FUNCTION [XDCL, #GATE] dbp$module_table_address: ^dbt$module_address_table_item;

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    dbp$module_table_address := tcb_p^.nosve.debug_table^.first_module_address_table_item;
  FUNCEND dbp$module_table_address;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] dbp$entry_point_table_address', EJECT ??
*copy dbh$entry_point_table_address

  FUNCTION [XDCL, #GATE] dbp$entry_point_table_address: ^dbt$entry_point_table;

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    dbp$entry_point_table_address := tcb_p^.nosve.debug_table^.entry_point_table;
  FUNCEND dbp$entry_point_table_address;
?? OLDTITLE ??
MODEND pmm$debug_table_builder;
