MODULE dum$display_all_names;
?? RIGHT := 110, LEFT := 1 ??
?? FMT (FORMAT := ON, keyw := upper, ident := lower) ??
?? PUSH (LISTEXT := ON) ??
*copyc clp$new_display_line
*copyc clp$new_display_page
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc dbt$entry_point_table
*copyc due$symbolic_access_exceptions
*copyc dup$display_language_variable
*copyc dup$display_string
*copyc dup$find_stack_frame_for_proc
*copyc dup$locate_next_symbol
*copyc dup$locate_symbol_for_number
*copyc dup$output_message
*copyc dut$variable_search_options
*copyc dut$variable_specification
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
?? POP ??
?? NEWTITLE := 'Global Definitions', EJECT ??
{ Note: In Basic, references to entire arrays require the array names to be appended with '()'.
{ That is to distinguish references of arrays from references of simple (i.e. non-array) variables.
{ To take care of up to 31 character names, the max name size (as expressed by osc$max_name_size)
{ has been expanded by 2.
{ Correspondingly, the item array of sym_name_list has been changed to an array of expanded names.

  CONST
    max_expanded_name_size = osc$max_name_size + 2,
    items_per_piece = 900;

  TYPE
    piece_number = 0 .. items_per_piece,
    sym_name_list_ptr = ^sym_name_list;

  TYPE
    sym_name_list = record
      forward_link: sym_name_list_ptr,
      backward_link: sym_name_list_ptr,
      number_of_items: piece_number,
      item: array [1 .. items_per_piece] of string (max_expanded_name_size),
    recend;
?? TITLE := 'dup$display_all_names', EJECT ??
*copyc duh$display_all_names

  PROCEDURE [XDCL] dup$display_all_names (
        home_spec: dut$home_specification;
        display_type: dut$display_type;
        p_variant_selection: ^clt$data_value;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    VAR
      active: boolean,
      message_status: ost$status,
      proc_start: ost$pva,
      target_sf: ost$pva,
      target_sf_save_area: ^ost$stack_frame_save_area,
      true_procedure_entry: dut$symbol_entry;

?? EJECT ??
{
{begin display_all_names
{

{
{Home_spec.procedure_entry could contain an llc$pascal_with_kind entry if this
{   is PASCAL.  Need to search through 'parents' to find a true procedure entry
{
    true_procedure_entry := home_spec.procedure_entry;
    IF true_procedure_entry.symbol <> NIL THEN
      WHILE true_procedure_entry.symbol^.symbol_kind <> llc$proc_kind DO
        dup$locate_symbol_for_number (home_spec.symbol_table_address,
              true_procedure_entry.symbol^.with_parent, true_procedure_entry, status);
        IF NOT status.normal THEN
          RETURN; {------->
        IFEND;
      WHILEND;
    IFEND;
{
{output 3 blank lines before starting
{
    clp$new_display_line (display_control_pointer^, 3, status);
    IF NOT status.normal THEN
      RETURN; {------->
    IFEND;
{
{output display header - if language is Cobol, go to a new page
{
    IF (home_spec.language = llc$cobol) THEN
      clp$new_display_page (display_control_pointer^, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;
{
{ If there is no procedure ptr, only module level variables are displayed.
{
    IF true_procedure_entry.symbol = NIL THEN
      IF home_spec.symbol_table_address <> NIL THEN
        osp$set_status_abnormal (duc$symbolic_id, due$display_all_names_hdr3,
          home_spec.symbol_table_address^.original_module_name, message_status);
        dup$output_message (message_status, display_control_pointer, status);
        IF NOT status.normal THEN
          RETURN; {------->
        IFEND;
      IFEND;
      active := FALSE;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$display_all_names_hdr1,
             true_procedure_entry.symbol^.symbol_name, message_status);
      dup$output_message (message_status, display_control_pointer, status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
{
{determine if the requested procedure is active.  otherwise, only static
{variables can be displayed.
{
      active := TRUE;
      IF home_spec.proc_recursion_level <> 0 THEN
        proc_start := home_spec.module_item^.section_item
                [true_procedure_entry.symbol^.proc_section_ordinal].address;
        proc_start.offset := proc_start.offset + true_procedure_entry.symbol^.proc_offset;
        dup$find_stack_frame_for_proc (proc_start, true_procedure_entry.symbol^.proc_length,
                    home_spec.stack_search_direction, home_spec.proc_recursion_level,
                    target_sf, target_sf_save_area, status);
        IF NOT status.normal THEN
{
{assume procedure is not active and output a second header line
{
          status.normal := TRUE;
          osp$set_status_abnormal (duc$symbolic_id, due$display_all_names_hdr2,
                       true_procedure_entry.symbol^.symbol_name, message_status);
          dup$output_message (message_status, display_control_pointer, status);
          IF NOT status.normal THEN
            RETURN; {------->
          IFEND;
          active := FALSE;
        IFEND;     { If NOT status.normal }
      IFEND;    { If recursion level <> 0 }
    IFEND;   {If true_procedure_entry.symbol <> NIL }
{
{output a blank line
{
    clp$new_display_line (display_control_pointer^, 1, status);
    IF NOT status.normal THEN
      RETURN; {------->
    IFEND;
{
{call a different procedure to process each different language
{
    CASE home_spec.language OF
    = llc$fortran =
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Fortran', status);
    = llc$cobol =
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cobol', status);
    ELSE
      display_all_cybil_names (home_spec, display_type, active, p_variant_selection,
            display_control_pointer, status);
    CASEND;
  PROCEND dup$display_all_names;
?? TITLE := 'display_all_cybil_names', EJECT ??

  PROCEDURE display_all_cybil_names (
        home_spec: dut$home_specification;
        display_type: dut$display_type;
        active: boolean;
        p_variant_selection: ^clt$data_value;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    TYPE
      base_type = set of llt$base_type;

    CONST
      bytes_per_word = 8,
      bits_per_byte = 8,
      reserved_stack_space = bytes_per_word * 2,
      right_justified_offset = 2;

    VAR
      first_level: boolean,
      interesting_bases: base_type,
      local_status: ost$status,
      message_status: ost$status,
      current_piece_ptr: sym_name_list_ptr,
      desired_index: piece_number,
      expanded_symbol_name: string (max_expanded_name_size),
      first_piece: sym_name_list,
      i: piece_number,
      j: sym_name_list_ptr,
      l: 1 .. max_expanded_name_size,
      last_piece_ptr: sym_name_list_ptr,
      new_piece_ptr: sym_name_list_ptr,
      place_to_stop: piece_number,
      end_of_chain: boolean,
      symbol_table_address: ^llt$debug_symbol_table,
      tmp_home_spec: dut$home_specification,
      current_proc: dut$symbol_entry,
      module_level_searched: boolean,
      nested_proc: boolean,
      search_options: dut$variable_search_options,
      symbol_item: llt$symbol_table_item,
      symbol_entry: dut$symbol_entry;

    VAR
      char_index: 1 .. max_expanded_name_size,
      var_type_symbol_entry: dut$symbol_entry;
?? NEWTITLE := 'allocate_more_space', EJECT ??

    PROCEDURE [INLINE] allocate_more_space;
      IF last_piece_ptr^.forward_link = NIL THEN
{ Need to allocate a new piece }
        PUSH new_piece_ptr;
        IF new_piece_ptr = NIL THEN
          osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
            'Debug cannot allocate enough stack space to complete the requested display.', status);
          RETURN; {----->
        IFEND;
        last_piece_ptr^.forward_link := new_piece_ptr;
        new_piece_ptr^.backward_link := last_piece_ptr;
        last_piece_ptr := new_piece_ptr;
        last_piece_ptr^.forward_link := NIL;
      ELSE
{ Next piece already there
        last_piece_ptr := last_piece_ptr^.forward_link;
      IFEND;
      last_piece_ptr^.number_of_items := 0;
    PROCEND allocate_more_space;
?? TITLE := 'add_new_item', EJECT ??

    PROCEDURE [INLINE] add_new_item;

            expanded_symbol_name := symbol_item.symbol_name;

{ If the symbol_name is a Basic array name, expand that name with '()'.

            IF home_spec.language = llc$basic THEN
              dup$locate_symbol_for_number (home_spec.symbol_table_address, symbol_entry.symbol^.var_type,
                    var_type_symbol_entry, status);
              IF var_type_symbol_entry.symbol^.symbol_kind = llc$basic_array_kind THEN
              /search_for_end_of_name/
                FOR char_index := 1 TO max_expanded_name_size DO
                  IF expanded_symbol_name (char_index) = ' ' THEN
                    expanded_symbol_name(char_index, 2) := '()';
                    EXIT /search_for_end_of_name/;
                  IFEND;
                FOREND;
              IFEND;
            IFEND;

{If this is the first item, put it into the first slot.

      IF first_piece.number_of_items = 0 THEN
        first_piece.item [1] := expanded_symbol_name;
        first_piece.number_of_items := 1;
        RETURN; {----->
      IFEND;

{If the new item goes after the last one, add it to the end.

      IF (expanded_symbol_name >= last_piece_ptr^.item [last_piece_ptr^.number_of_items]) THEN
        IF (last_piece_ptr^.number_of_items = items_per_piece) THEN
          allocate_more_space;
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
        last_piece_ptr^.number_of_items := last_piece_ptr^.number_of_items + 1;
        last_piece_ptr^.item [last_piece_ptr^.number_of_items] := expanded_symbol_name;
        RETURN; {----->
      IFEND;

{Find the correct place in the table so that items remained sorted.

      current_piece_ptr := ^first_piece;

    /loop1/
      WHILE TRUE DO
        FOR i := 1 TO current_piece_ptr^.number_of_items DO
          IF expanded_symbol_name <= current_piece_ptr^.item [i] THEN
            desired_index := i;
            EXIT /loop1/;
          IFEND;
        FOREND;
        IF current_piece_ptr^.forward_link = NIL THEN
          desired_index := current_piece_ptr^.number_of_items;
          EXIT /loop1/;
        IFEND;
        current_piece_ptr := current_piece_ptr^.forward_link;
      WHILEND /loop1/;

{Put new symbol before theone pointed to by current_piece_ptr indexed by
{desired_index, pushing down following entries.

      j := last_piece_ptr;

    /loop2/
      WHILE TRUE DO
        IF j = current_piece_ptr THEN
          place_to_stop := desired_index;
        ELSE
          place_to_stop := 1;
        IFEND;
        IF j^.number_of_items = items_per_piece THEN
          IF j^.forward_link = NIL THEN
            allocate_more_space;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
          IFEND;
          j^.forward_link^.item [1] := j^.item [items_per_piece];
          j^.forward_link^.number_of_items := j^.forward_link^.number_of_items + 1;
          j^.number_of_items := j^.number_of_items - 1;
        IFEND;
        FOR i := j^.number_of_items DOWNTO place_to_stop DO
          j^.item [i + 1] := j^.item [i];
        FOREND;
        IF j = current_piece_ptr THEN
          EXIT /loop2/;
        IFEND;
        j := j^.backward_link;
      WHILEND /loop2/;
      current_piece_ptr^.item [desired_index] := expanded_symbol_name;
      current_piece_ptr^.number_of_items := current_piece_ptr^.number_of_items + 1;
    PROCEND add_new_item;
?? TITLE := 'calculate_trailing_blanks', EJECT ??

    PROCEDURE [INLINE] calculate_trailing_blanks;

    /calc_loop/
      FOR l := max_expanded_name_size DOWNTO 1 DO
        IF j^.item [i] (l, 1) <> ' ' THEN
          EXIT /calc_loop/;
        IFEND;
      FOREND /calc_loop/;
    PROCEND calculate_trailing_blanks;

?? OLDTITLE ??
?? EJECT ??
{This begins procedure 'display_all_cybil_names'.

{In Cybil, name=$all means all symbols from the symbol table of symbol_kind llc$var_kind and
{llc$constant_kind.  If the requested procedure is not active, then only those symbols whose base type
{is llc$static_base can be output.  The symbols are sorted before being printed.

    first_level := TRUE;    {Don't put out header the first time}

{Initialization for sort.

    first_piece.forward_link := NIL;
    first_piece.backward_link := NIL;

{ Set up search options depending on the language

    tmp_home_spec := home_spec;
    CASE home_spec.language OF
    = llc$basic,
      llc$pascal,
      llc$the_c_language =
      search_options := $dut$variable_search_options [
                   duc$search_outer_procedures];
    ELSE
      search_options := $dut$variable_search_options [
                   duc$search_outer_procedures, duc$search_module_level];
    CASEND;

{Determine base type.

    symbol_table_address := home_spec.symbol_table_address;
    local_status.normal := TRUE;
    IF active THEN
      interesting_bases := $base_type [llc$static_base, llc$stack_frame_base, llc$parm_list_base,
            llc$xref_base];
    ELSE
      interesting_bases := $base_type [llc$static_base, llc$xref_base];
    IFEND;

    current_proc := home_spec.procedure_entry;
    IF current_proc.symbol <> NIL THEN
{ Make sure current_proc isn't a PASCAL WITH block entry }
      WHILE current_proc.symbol^.symbol_kind <> llc$proc_kind DO
        dup$locate_symbol_for_number (home_spec.symbol_table_address, current_proc.symbol^.with_parent,
              current_proc, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      WHILEND;
    IFEND;
    module_level_searched := FALSE;
    end_of_chain := FALSE;

    REPEAT
    { Reset the symbol name area }
      first_piece.number_of_items := 0;
      last_piece_ptr := ^first_piece;

    /search_lexical_level/
      BEGIN
        IF current_proc.symbol <> NIL THEN
          IF current_proc.symbol^.first_symbol_for_proc = 0 THEN
            EXIT /search_lexical_level/; {no symbols at this level}
          IFEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address, current_proc.symbol^.
                first_symbol_for_proc, symbol_entry, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        ELSE
          module_level_searched := TRUE;
          dup$locate_symbol_for_number (home_spec.symbol_table_address, home_spec.symbol_table_address^.
                first_symbol_for_module, symbol_entry, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        REPEAT
          IF ((symbol_entry.symbol^.symbol_kind = llc$var_kind) AND (symbol_entry.symbol^.var_base IN
                interesting_bases)) OR ((symbol_entry.symbol^.symbol_kind = llc$constant_kind) AND
                (symbol_entry.symbol^.symbol_name <> osc$null_name)) THEN
            symbol_item := symbol_entry.symbol^;
            add_new_item;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
          IFEND;
          IF (symbol_entry.symbol = NIL) OR (symbol_entry.symbol^.end_of_chain) THEN
            EXIT /search_lexical_level/;
          IFEND;
          dup$locate_next_symbol (home_spec.symbol_table_address, symbol_entry, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        UNTIL end_of_chain;
      END /search_lexical_level/;

      tmp_home_spec.procedure_entry := current_proc;
      IF first_level THEN
        first_level := FALSE;
      ELSE
        IF current_proc.symbol <> NIL THEN
          osp$set_status_abnormal (duc$symbolic_id, due$display_all_names_hdr1,
                   current_proc.symbol^.symbol_name, message_status);
          dup$output_message (message_status, display_control_pointer, status);
        ELSE
{ CYBIL module names are case sensitive.  Make them upper case.  This code
{  should be removed when CYBIL changes to upper case. 7/86.
          expanded_symbol_name := home_spec.symbol_table_address^.original_module_name;
          IF (home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil) THEN
            #TRANSLATE (osv$lower_to_upper, expanded_symbol_name, expanded_symbol_name);
          IFEND;
          osp$set_status_abnormal (duc$symbolic_id, due$display_all_names_hdr3,
                        expanded_symbol_name, message_status);
          dup$output_message (message_status, display_control_pointer, status);
        IFEND;
        clp$new_display_line (display_control_pointer^, 1, status);
        IF NOT status.normal THEN
          RETURN; {------->
        IFEND;
      IFEND;
      IF first_piece.number_of_items = 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$no_vars_found, osc$null_name, message_status);
        dup$output_message (message_status, display_control_pointer, status);
      IFEND;
      j := ^first_piece;

    /display_loop/
      WHILE j <> NIL DO
        FOR i := 1 TO j^.number_of_items DO
          calculate_trailing_blanks;

          dup$display_language_variable (^j^.item [i] (1, l), tmp_home_spec, display_type,
                     p_variant_selection, display_control_pointer, local_status);
          IF NOT local_status.normal THEN
            clp$new_display_line (display_control_pointer^, 0, status);
            dup$output_message (local_status, display_control_pointer, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            local_status.normal := TRUE;
          IFEND;
        FOREND;
        j := j^.forward_link;
      WHILEND /display_loop/;
      clp$new_display_line (display_control_pointer^, 1, status);

{Check the next outer level of procedure nesting if there is one.

      IF (current_proc.symbol <> NIL) AND
         (NOT (duc$search_outer_procedures IN search_options)) AND
         (NOT (llc$proc_uses_outer_level_stack IN current_proc.symbol^.proc_attributes)) THEN
        current_proc.symbol := NIL;
      IFEND;
      IF current_proc.symbol <> NIL THEN
        IF current_proc.symbol^.proc_parent = 0 THEN
          current_proc.symbol := NIL;
        ELSE
          nested_proc := TRUE;
          dup$locate_symbol_for_number (home_spec.symbol_table_address, current_proc.symbol^.proc_parent,
                current_proc, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
      IFEND;
      IF (current_proc.symbol = NIL) AND
         (NOT(duc$search_module_level IN search_options)) THEN
        module_level_searched := TRUE;
      IFEND;
    UNTIL module_level_searched;
    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;
  PROCEND display_all_cybil_names;
?? OLDTITLE ??
MODEND dum$display_all_names;
