From b2bd2d4b7f20a38c9b8fd8aa8f3bd1a955b7ca79 Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Sat, 14 Dec 2024 19:44:10 -0500
Subject: [PATCH] WIP: Still sorting out code for GDB-COBOL PERFORM <proc>
TIMES
---
gcc/cobol/failures/Makefile.inc | 4 +-
gcc/cobol/failures/playpen/playpen.cbl | 17 ++++-----
gcc/cobol/genapi.cc | 53 +++++++++++++++++---------
3 files changed, 43 insertions(+), 31 deletions(-)
diff --git a/gcc/cobol/failures/Makefile.inc b/gcc/cobol/failures/Makefile.inc
index dd1b31fda58d..495c3ff51d74 100644
--- a/gcc/cobol/failures/Makefile.inc
+++ b/gcc/cobol/failures/Makefile.inc
@@ -38,7 +38,7 @@ ifeq ($(PROCESSOR), x86_64)
$(DEBUG) -O0 -o $(basename $(SOURCE_FILE)).s
endif
$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0 -o test $(GCOPTIONS) $(SOURCE_FILE) \
- $(COBOL_RUNTIME_LIBRARY)
+ $(COBOL_RUNTIME_LIBRARY) -Wa,-a > $(basename $(SOURCE_FILE)).lst
./test < input.txt
ifneq ("$(AFTER)","")
./$(AFTER)
@@ -67,7 +67,7 @@ tests:
$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0 -S -o test.s $(GCOPTIONS) $(SOURCE_FILE)
$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0 -o test $(GCOPTIONS) $(SOURCE_FILE) \
$(COBOL_RUNTIME_LIBRARY) \
- -Wa,-aln > $(basename $(SOURCE_FILE)).lst
+ -Wa,-a > $(basename $(SOURCE_FILE)).lst
.PHONY: gc
gc:
diff --git a/gcc/cobol/failures/playpen/playpen.cbl b/gcc/cobol/failures/playpen/playpen.cbl
index 55b9c1c91c25..7f616d0f44c0 100644
--- a/gcc/cobol/failures/playpen/playpen.cbl
+++ b/gcc/cobol/failures/playpen/playpen.cbl
@@ -1,18 +1,15 @@
identification division.
program-id. prog.
procedure division.
- perform hello through goodbye 3 times
+ perform hello 3 times
+ continue.
+ bad_next_no_biscuit.
+ perform hello 3 times
continue.
quit.
goback.
hello.
- display "Hello1"
- display "Hello2"
- display "Hello3"
- continue.
- Goodbye.
- display "Goodbye1"
- display "Goodbye2"
- display "Goodbye3"
- continue.
+ display "Hello1".
+ display "Hello2".
+ display "Hello3".
end program prog.
\ No newline at end of file
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index a767df0513e6..5bf76a360478 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -93,6 +93,7 @@ static void hijack_for_development(const char *funcname);
static size_t sv_data_name_counter = 1;
static int call_counter = 1;
+static int pseudo_label = 1;
static bool suppress_cobol_entry_point = false;
static char ach_cobol_entry_point[256] = "";
@@ -2538,7 +2539,6 @@ leave_procedure(struct cbl_proc_t *procedure, bool /*section*/)
"_procret.%ld:",
symbol_label_id(procedure->label));
gg_insert_into_assembler(ach);
-
pseudo_return_pop(procedure);
gg_append_statement(procedure->bottom.label);
}
@@ -3121,11 +3121,11 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count )
char ach[256];
- size_t our_call_counter = call_counter++;
+ size_t our_pseudo_label = pseudo_label++;
sprintf(ach,
- "_proccall.%ld:",
- our_call_counter);
+ "_proccallb.%ld:",
+ our_pseudo_label);
gg_insert_into_assembler( ach );
tree counter = gg_define_variable(LONG);
@@ -3146,8 +3146,8 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count )
WEND
sprintf(ach,
- "_procret.%ld:",
- our_call_counter);
+ "_procretb.%ld:",
+ our_pseudo_label);
gg_insert_into_assembler(ach);
}
@@ -3270,12 +3270,12 @@ internal_perform_through_times( cbl_label_t *proc_1,
TRACE1_END
}
- size_t our_call_counter = call_counter++;
+ size_t our_pseudo_label = pseudo_label++;
char ach[256];
sprintf(ach,
- "_proccall.%ld:",
- our_call_counter);
+ "_proccallb.%ld:",
+ our_pseudo_label);
gg_insert_into_assembler( ach );
tree counter = gg_define_variable(LONG);
@@ -3291,10 +3291,9 @@ internal_perform_through_times( cbl_label_t *proc_1,
WEND
sprintf(ach,
- "_procret.%ld:",
- our_call_counter);
+ "_procretb.%ld:",
+ our_pseudo_label);
gg_insert_into_assembler( ach );
-
}
void
@@ -7808,15 +7807,19 @@ perform_outofline_before_until(struct cbl_perform_tgt_t *tgt,
gg_append_statement(tgt->addresses.condback[0].label);
parser_if(varys[0].until);
- // We're done, so leave
- gg_append_statement(tgt->addresses.exit.go_to);
+ {
+ // We're done, so leave
+ gg_append_statement(tgt->addresses.exit.go_to);
+ }
parser_else();
- // We're not done, so execute the body
- // true means GDB next will fall through
- internal_perform_through(tgt->from(), tgt->to(), true);
+ {
+ // We're not done, so execute the body
+ // true means GDB next will fall through
+ internal_perform_through(tgt->from(), tgt->to(), true);
- // Jump back to the test:
- gg_append_statement(tgt->addresses.top.go_to );
+ // Jump back to the test:
+ gg_append_statement(tgt->addresses.top.go_to );
+ }
parser_fi();
// Label the bottom of the PERFORM
@@ -7847,6 +7850,13 @@ perform_outofline_after_until(struct cbl_perform_tgt_t *tgt,
EXIT:
*/
+ char ach[256];
+ size_t our_pseudo_label = pseudo_label++;
+ sprintf(ach,
+ "_proccallb.%ld:",
+ our_pseudo_label);
+ gg_insert_into_assembler( ach );
+
create_iline_address_pairs(tgt);
// Label the top of the loop
@@ -7872,6 +7882,11 @@ perform_outofline_after_until(struct cbl_perform_tgt_t *tgt,
gg_append_statement( tgt->addresses.top.go_to );
parser_fi();
// Label the bottom of the PERFORM
+ sprintf(ach,
+ "_procretb.%ld:",
+ our_pseudo_label);
+ gg_insert_into_assembler(ach);
+ gg_insert_into_assembler( ach );
gg_append_statement( tgt->addresses.exit.label );
}
--
GitLab