diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index f98c195bb10207e25dc8c7eb9f8210f477a2ec9a..58a0cbf3bd1727d7e66c5fe2d53ffa1e54a30eca 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -51,9 +51,6 @@
#define TSI_BACK (tsi_last(current_function->statement_list_stack.back()))
-//#define XXX do{gg_printf("LINE %d\n", build_int_cst_type(INT, __LINE__), NULL_TREE);}while(0);
-#define XXX
-
static std::unordered_map<std::string, std::string> main_strings;
extern char *cobol_name_mangler(const char *cobol_name);
@@ -79,6 +76,8 @@ int show_parse_indent = 0;
#define DEFAULT_LINE_NUMBER 2
+static bool back_up_one = false;
+
#if 0
static void
line_tick()
@@ -895,7 +894,19 @@ void parser_statement_begin()
gg_assign(var_decl_nop, build_int_cst_type(INT, 106));
}
- gg_set_current_line_number(CURRENT_LINE_NUMBER);
+ back_up_one = false;
+
+ if( back_up_one )
+ {
+ // This is a Hail Mary play to make a GDB-COBOL BREAK <PROC> stop on the
+ // name of a paragraph or section.
+ gg_set_current_line_number(CURRENT_LINE_NUMBER-1);
+ back_up_one = false;
+ }
+ else
+ {
+ gg_set_current_line_number(CURRENT_LINE_NUMBER);
+ }
}
static void
@@ -2312,8 +2323,6 @@ assembler_label(const char *label)
strcat(build, label);
strcat(build, local_text);
- gg_assign(var_decl_nop, build_int_cst_type(INT, 107));
-
gg_insert_into_assembler(build);
}
@@ -2323,6 +2332,8 @@ section_label(struct cbl_proc_t *procedure)
// With nested programs, you can have multiple program/section pairs with the
// the same names; we use a deconflictor to avoid collisions
+ gg_set_current_line_number(CURRENT_LINE_NUMBER);
+
static size_t deconflictor = symbol_label_id(procedure->label);
cbl_label_t *label = procedure->label;
@@ -2340,7 +2351,15 @@ section_label(struct cbl_proc_t *procedure)
sprintf(secname,
"_sect.%s",
combined_name(procedure->label));
+ SHOW_PARSE
+ {
+ SHOW_PARSE_HEADER
+ SHOW_PARSE_TEXT(secname);
+ SHOW_PARSE_END
+ }
+ back_up_one = true;
assembler_label(secname);
+ gg_assign(var_decl_nop, build_int_cst_type(INT, 107));
}
static void
@@ -2354,6 +2373,9 @@ paragraph_label(struct cbl_proc_t *procedure)
// 2) paragraph names can be duplicated in a section, provided that they
// are not referenced by the program. We provide a deconflictor to
// separate such labels.
+
+ gg_set_current_line_number(CURRENT_LINE_NUMBER);
+
cbl_label_t *paragraph = procedure->label;
cbl_label_t *section = nullptr;
@@ -2377,12 +2399,22 @@ paragraph_label(struct cbl_proc_t *procedure)
deconflictor);
gg_insert_into_assembler(ach);
+ SHOW_PARSE
+ {
+ SHOW_PARSE_HEADER
+ SHOW_PARSE_TEXT(ach);
+ SHOW_PARSE_END
+ }
+
// The label has to start with an underscore. I tried a period, but those
// don't seem to show up in GDB's internal symbol tables.
sprintf(ach,
"_para.%s",
combined_name(procedure->label));
+ back_up_one = true;
assembler_label(ach);
+
+ gg_assign(var_decl_nop, build_int_cst_type(INT, 108));
}
static void
@@ -2580,6 +2612,7 @@ find_procedure(cbl_label_t *label)
// defined more than once. Had it been referenced with a GOTO or PERFORM,
// that would have been a syntax error.
//
+ //
// In this case, we need to replace the existing cbl_proc_t structure. We
// will be laying down labels for this second (or more) instance of
// parser_enter_paragraph, and we must create different labels.
@@ -2685,11 +2718,6 @@ parser_enter_paragraph(cbl_label_t *label)
CHECK_LABEL(label);
- // This NOP is needed to give GDB a line number for the entry point of
- // paragraphs
- gg_set_current_line_number(CURRENT_LINE_NUMBER);
- gg_assign(var_decl_nop, build_int_cst_type(INT, 102));
-
struct cbl_proc_t *procedure = find_procedure(label);
gg_append_statement(procedure->top.label);
paragraph_label(procedure);
@@ -4525,7 +4553,6 @@ parser_accept_date_yyyymmdd( struct cbl_field_t *target )
move_tree_to_field( target,
pointer);
- XXX;
gg_free(pointer);
TRACE1
@@ -4556,7 +4583,6 @@ parser_accept_date_yyddd( struct cbl_field_t *target )
move_tree_to_field( target,
pointer);
- XXX;
gg_free(pointer);
TRACE1
@@ -4587,7 +4613,6 @@ parser_accept_date_yyyyddd( struct cbl_field_t *target )
move_tree_to_field( target,
pointer);
- XXX;
gg_free(pointer);
TRACE1
@@ -4618,7 +4643,6 @@ parser_accept_date_dow( struct cbl_field_t *target )
move_tree_to_field( target,
pointer);
- XXX;
gg_free(pointer);
TRACE1
@@ -4649,7 +4673,6 @@ parser_accept_date_hhmmssff( struct cbl_field_t *target )
move_tree_to_field( target,
pointer);
- XXX;
gg_free(pointer);
TRACE1
@@ -5862,7 +5885,7 @@ static
void
pe_stuff(cbl_refer_t refer, ec_type_t ec)
{
- // This is the moral equivalent of a C "return XXX;".
+ // This is the moral equivalent of a C "return xyz;".
// There cannot be both a non-zero exit status and an exception condition.
gcc_assert( !(ec != ec_none_e && refer.field != NULL) );
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 8f98068f11d4051bc1f07ffc3730a7441b69c375..fb9f98e0b451e242614fcea1856358387d071ba5 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -169,7 +169,11 @@ size_t __gg__call_parameter_lengths[ARG_LIMIT];
void *__gg__entry_location = NULL;
-// This needs a comment. Right now I don't remember what it is for.
+// This is the current value at the back of the PERFORM <PROC> stack of
+// procedure signatures. Said another way: When the exit address at
+// the end of a paragraph matches this value address, then it is time to pop
+// the return address off of the stack. It's in this fashion that we implements
+// nested PERFORM PROC statements.
void *__gg__exit_address = NULL;
static ec_status_t ec_status;