Skip to content

Commit

Permalink
New version
Browse files Browse the repository at this point in the history 
* Do not check for enter/exit section: instead, accumulate from paragraphs
* Support for modules and ENTRY points
  • Loading branch information
@lefessan
lefessan committed Nov 27, 2023
1 parent ac2d932 commit a004c43
Show file tree
Hide file tree
Showing 17 changed files with 515 additions and 354 deletions.
4 changes: 3 additions & 1 deletion cobc/cobc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2287,7 +2287,9 @@ cobc_clean_up (const int status)
if (fn->need_assemble
&& (status
|| cb_compile_level > CB_LEVEL_ASSEMBLE
|| (cb_compile_level == CB_LEVEL_ASSEMBLE && save_temps))) {
|| (cb_compile_level == CB_LEVEL_ASSEMBLE
&& save_temps
&& !output_name))) {
cobc_check_action (fn->object);
}
clean_up_intermediates (fn, status);
Expand Down
273 changes: 203 additions & 70 deletions cobc/codegen.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4296,81 +4296,193 @@ output_funcall_item (cb_tree x, const int i, unsigned int func_nolitcast)



/* Data and functions used for profiling */
static struct cb_text_list *procedures_list;
static int procedures_list_len = 0;

static const char *cob_prof_exit_paragraph_str = "cob_prof_exit_paragraph";
static const char *cob_prof_exit_section_str = "cob_prof_exit_section";
static const char *cob_prof_enter_paragraph_str = "cob_prof_enter_paragraph";
static const char *cob_prof_enter_section_str = "cob_prof_enter_section";
static const char *cob_prof_use_paragraph_entry_str = "cob_prof_use_paragraph_entry";
static const char *cob_prof_stayin_paragraph_str = "cob_prof_stayin_paragraph";


/* Returns the name of the procedure as expected by profiling
* formats. The string is statically allocated, so it must be
* reallocated for long term usage. */
static char*
get_procedure_name (struct cb_label *section, struct cb_label *paragraph)
get_procedure_name (struct cb_program * program,
struct cb_label * section,
struct cb_label * paragraph,
const char * entry)
{
static char procedure_name[COB_NORMAL_BUFF];

if (entry){
sprintf (procedure_name, "%s|%s|%s.%s|%s:%d",
program->program_id,
section->name, paragraph->name,
entry,
paragraph->common.source_file, paragraph->common.source_line);
return procedure_name;
}
if (paragraph){
sprintf (procedure_name, "%s|%s|%s:%d", section->name, paragraph->name,
sprintf (procedure_name, "%s|%s|%s|%s:%d",
program->program_id,
section->name, paragraph->name,
paragraph->common.source_file, paragraph->common.source_line);
} else {
sprintf (procedure_name, "%s||%s:%d", section->name,
return procedure_name;
}
if (section){
sprintf (procedure_name, "%s|%s||%s:%d",
program->program_id,
section->name,
section->common.source_file, section->common.source_line);
return procedure_name;
}
sprintf (procedure_name, "%s|||%s:%d",
program->program_id,
program->common.source_file, program->common.source_line);
return procedure_name;
}

/* Returns a tree node for a funcall to one of the profiling functions, with the name of the procedure
as argument. If the procedure is being entered, register the procedure into procedures_list. */
cb_tree
cb_build_prof_call (enum cb_prof_call prof_call, struct cb_label *section, struct cb_label *paragraph)
static int
procedure_list_add (
struct cb_program *program,
const char *name,
enum cob_prof_procedure_kind kind,
const char *text,
int section,
const char *file,
int line
)
{
const char* prof_call_name;
const char* name;
cb_tree cb_str;
int declare_procedure = 0;
struct cb_procedure_list *p;
int ret = program->procedure_list_len ;

p = cobc_main_malloc (sizeof (struct cb_procedure_list));
p->proc.name = cobc_main_strdup (name);
p->proc.text = cobc_main_strdup (text);
p->proc.kind = kind;
p->proc.file = file;
p->proc.line = line;
p->proc.section = section;

if (program->procedure_list == NULL){
program->procedure_list = p;
p->last = p;
p->next = NULL;
} else {
program->procedure_list->last->next = p;
program->procedure_list->last = p;
}

program->procedure_list_len++;
return ret;
}


/* Returns a tree node for a funcall to one of the profiling
functions, with the index of the procedure as argument. If the
procedure is being entered, register the procedure into
procedure_list. */
cb_tree
cb_build_prof_call (enum cb_prof_call prof_call,
struct cb_program * program,
struct cb_label * section,
struct cb_label * paragraph,
const char * entry)
{
const char * func_name;
int func_arg1;
int func_arg2 = -1;

if (program->procedure_list == NULL){
/* invariant: program always has index 0 */
procedure_list_add (
program,
get_procedure_name (program, NULL, NULL, NULL),
COB_PROF_PROCEDURE_MODULE,
program->program_id,
0,
program->common.source_file,
program->common.source_line);
}

switch (prof_call){
case COB_PROF_EXIT_PARAGRAPH:
prof_call_name = cob_prof_exit_paragraph_str;
break;
case COB_PROF_EXIT_SECTION:
prof_call_name = cob_prof_exit_section_str;
paragraph = NULL;
case COB_PROF_ENTER_SECTION:
func_name = cob_prof_enter_section_str;
program->prof_current_section =
procedure_list_add (
program,
get_procedure_name (program, section, NULL, NULL),
COB_PROF_PROCEDURE_SECTION,
section->name,
/* the current section will have
* procedure_list_list as index */
program->procedure_list_len,
section->common.source_file,
section->common.source_line);
program->prof_current_paragraph = -1;
func_arg1 = program->prof_current_section;
break;
case COB_PROF_ENTER_PARAGRAPH:
prof_call_name = cob_prof_enter_paragraph_str;
declare_procedure = 1;
func_name = cob_prof_enter_paragraph_str;
program->prof_current_paragraph =
procedure_list_add (
program,
get_procedure_name (program, section, paragraph, NULL),
COB_PROF_PROCEDURE_PARAGRAPH,
paragraph->name,
program->prof_current_section,
paragraph->common.source_file,
paragraph->common.source_line);
func_arg1 = program->prof_current_paragraph;
break;
case COB_PROF_ENTER_SECTION:
prof_call_name = cob_prof_enter_section_str;
paragraph = NULL;
declare_procedure = 1;
case COB_PROF_EXIT_PARAGRAPH:
func_name = cob_prof_exit_paragraph_str;
func_arg1 = program->prof_current_paragraph;
/* Do not reinitialize, because we may have several of these
EXIT_PARAGRAPH, for example at EXIT SECTION.
program->prof_current_paragraph = -1; */
break;
}
case COB_PROF_USE_PARAGRAPH_ENTRY:
func_name = cob_prof_use_paragraph_entry_str;
func_arg1 = program->prof_current_paragraph;
func_arg2 =
procedure_list_add (
program,
get_procedure_name (program, section, paragraph, entry),
COB_PROF_PROCEDURE_ENTRY,
entry,
program->prof_current_paragraph,
section->common.source_file,
section->common.source_line);
break;
case COB_PROF_STAYIN_PARAGRAPH:
func_name = cob_prof_stayin_paragraph_str;
func_arg1 = program->prof_current_paragraph;
break;
case COB_PROF_EXIT_SECTION:
func_name = cob_prof_exit_section_str;
func_arg1 = program->prof_current_section;
program->prof_current_section = -1;
program->prof_current_paragraph = -1;

name = get_procedure_name (section, paragraph);
if (declare_procedure){
procedures_list = cb_text_list_add (procedures_list, name);
procedures_list_len++;
}
cb_str = cb_build_string (cobc_parse_strdup (name), strlen (name));
return CB_BUILD_FUNCALL_1 (prof_call_name, cb_str);
if (func_arg2 < 0){
return CB_BUILD_FUNCALL_1 (func_name, cb_int (func_arg1));
}
return CB_BUILD_FUNCALL_2 (func_name, cb_int (func_arg1), cb_int (func_arg2));
}

/* Returns the index of the procedure in the procedures_list, or -1 if not found */
/* Returns the index of the procedure in the procedure_list, or -1 if not found */
static int
get_procedure_idx (const char* text)
get_procedure_index (struct cb_program * program, const char * name)
{
struct cb_text_list *l = procedures_list;
struct cb_procedure_list *l = program->procedure_list;
int i = 0;

while (!!l) {
if (!strcmp (text, l->text)) {
if (!strcmp (name, l->proc.name)) {
return i;
}
l = l->next;
Expand All @@ -4395,14 +4507,30 @@ output_funcall (cb_tree x)
return;
}

if ( cb_flag_prof && (
p->name == cob_prof_enter_paragraph_str
if ( cb_flag_prof ) {
if ( p->name == cob_prof_enter_paragraph_str
|| p->name == cob_prof_exit_paragraph_str
|| p->name == cob_prof_enter_section_str
|| p->name == cob_prof_exit_section_str )) {
int proc_idx = get_procedure_idx( (char*) CB_STRING(p->argv[0])->data);
output ("%s (prof_info, %d)", p->name, proc_idx);
return;
|| p->name == cob_prof_exit_section_str ) {
int proc_idx = CB_INTEGER(p->argv[0])->val;
output ("%s (prof_info, %d)", p->name, proc_idx);
return;
}

if (p->name == cob_prof_use_paragraph_entry_str){
int paragraph_idx = CB_INTEGER(p->argv[0])->val;
int entry_idx = CB_INTEGER(p->argv[1])->val;
output ("if (!cob_prof_fallthrough_entry){\n");
output ("\t%s (prof_info, %d, %d);\n",
cob_prof_use_paragraph_entry_str, paragraph_idx, entry_idx);
output (" }\n");
output (" cob_prof_fallthrough_entry = 0");
return;
}
if (p->name == cob_prof_stayin_paragraph_str){
output ("cob_prof_fallthrough_entry = 1");
return;
}
}


Expand Down Expand Up @@ -7971,18 +8099,7 @@ output_goto_1 (cb_tree x)
}

if (cb_flag_prof) {
/* If no section, then lb = section or exit label */

int idx;
if (lb->section) {
idx = get_procedure_idx ( get_procedure_name (lb->section, lb));
} else {
idx = get_procedure_idx ( get_procedure_name (lb, NULL));
/* If idx == -1 then GO TO exit, no need to generate a call */
}
if (idx != -1) {
output_line("cob_prof_goto (prof_info, %d);", idx);
}
output_line("cob_prof_goto (prof_info);");
}
output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id);
}
Expand Down Expand Up @@ -12294,7 +12411,8 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
/* Entry dispatch */
output_line ("/* Entry dispatch */");
if (cb_flag_prof) {
output_line("if (!prof_info) { prof_info = cob_prof_init (\"%s\", procedures_names, %d); }", prog->orig_program_id, procedures_list_len);
output_line("if (!prof_info) { prof_info = cob_prof_init (\"%s\", prof_procedures, %d); }", prog->orig_program_id, prog->procedure_list_len);
output_line("cob_prof_enter_program(prof_info);");
}
if (cb_flag_stack_extended) {
/* entry marker = first frameptr is the one with
Expand Down Expand Up @@ -12390,7 +12508,9 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
output_newline ();
}
}

if (cb_flag_prof){
output_line("cob_prof_exit_program(prof_info);");
}
if (!prog->flag_recursive) {
output_line ("/* Decrement module active count */");
output_line ("if (module->module_active) {");
Expand Down Expand Up @@ -13726,27 +13846,40 @@ output_header (const char *locbuff, const struct cb_program *cp)
}

static void
output_cob_prof_data ()
output_cob_prof_data ( struct cb_program * program )
{
if (cb_flag_prof) {
struct cb_text_list *l = procedures_list;
struct cb_procedure_list *l;
char sep = ' ';

output_local ("/* cob_prof data */\n\n");

output_local ("static const char *procedures_names[%d] = {\n", procedures_list_len + 1);
while (l) {
output_local (" \"%s\",\n", l->text);
l = l->next;
output_local ("static const int nprocedures = %d;\n",
program->procedure_list_len);
output_local ("static struct cob_prof_procedure prof_procedures[%d] = {\n",
program->procedure_list_len);
sep = ' ';
for (l = program->procedure_list; l; l=l->next) {
output_local (" %c { \"%s\", %d, \"%s\", %d, \"%s\", %d }\n",
sep,
l->proc.name,
l->proc.kind,
l->proc.text,
l->proc.section,
l->proc.file, l->proc.line);
sep = ',';
}
output_local (" \"\"");
output_local ("};\n");

output_local ("static struct cobprof_info *prof_info;\n");
output_local ("};\n");
output_local ("static int cob_prof_fallthrough_entry = 0;\n");
output_local ("static struct cob_prof_module *prof_info;\n");

output_local ("\n/* End of cob_prof data */\n");

procedures_list = NULL;
procedures_list_len = 0;
program->procedure_list = NULL;
program->procedure_list_len = 0;
program->prof_current_section = -1;
program->prof_current_paragraph = -1;
}
}

Expand Down Expand Up @@ -14025,7 +14158,7 @@ codegen_internal (struct cb_program *prog, const int subsequent_call)

output_local_base_cache ();
output_local_field_cache (prog);
output_cob_prof_data ();
output_cob_prof_data (prog);

/* Report data fields */
if (prog->report_storage) {
Expand Down
Loading

0 comments on commit a004c43

Please sign in to comment.