From a68f46e30ce2d201e7ae5656690c648514d4a29b Mon Sep 17 00:00:00 2001 From: Emilien Lemaire Date: Wed, 26 Jul 2023 13:54:41 +0200 Subject: [PATCH] Profiling mode to generate CSV reports Initial work by Emilien Lemaire , completed by Fabrice Le Fessant --- ChangeLog | 1 - cobc/ChangeLog | 11 + cobc/cobc.c | 2 +- cobc/cobc.h | 4 + cobc/codegen.c | 141 ++++++++ cobc/flag.def | 3 + cobc/parser.y | 32 +- cobc/tree.h | 12 + configure.ac | 6 +- doc/ChangeLog | 4 + doc/gnucobol.texi | 148 +++++++- libcob/ChangeLog | 12 + libcob/Makefile.am | 4 +- libcob/coblocal.h | 5 + libcob/cobprof.h | 61 ++++ libcob/common.c | 10 +- libcob/common.h | 1 + libcob/profiling.c | 488 +++++++++++++++++++++++++++ tests/ChangeLog | 4 + tests/testsuite.src/listings.at | 18 +- tests/testsuite.src/used_binaries.at | 121 +++++++ 21 files changed, 1067 insertions(+), 21 deletions(-) create mode 100644 libcob/cobprof.h create mode 100644 libcob/profiling.c diff --git a/ChangeLog b/ChangeLog index b34676236..1909ca2cb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,3 @@ - 2023-07-28 Simon Sobisch * configure.ac: check for mousemask and mmask_t diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 0c5659e71..c16164123 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,3 +1,14 @@ +2023-09-04 Emilien Lemaire + + * parser.y: add variables for profiling, and a `cb_test_list_add` function + * parser.y: generate `cob_prof_enter` and `cob_prof_exit` calls when + needed + * flag.def: add `-fprof` to enable profiling + * cobc.h: add an extern `cb_text_list` struct, to save the name of all + created procedures and global variables of this type + * typeck.c (emit_stop_run): add a call to `cob_prof_end` before the call + to `cob_stop_run` + * codegen.c: handle profiling code generation 2023-07-26 Simon Sobisch diff --git a/cobc/cobc.c b/cobc/cobc.c index b3a52303c..27d313bda 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -1446,7 +1446,7 @@ cobc_check_string (const char *dupstr) return s->val; } -static struct cb_text_list * +struct cb_text_list * cb_text_list_add (struct cb_text_list *list, const char *text) { struct cb_text_list *p; diff --git a/cobc/cobc.h b/cobc/cobc.h index 73f3d7a23..f5b4040db 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -684,4 +684,8 @@ extern int cb_strcasecmp (const void *, const void *); extern unsigned char cb_toupper (const unsigned char); extern unsigned char cb_tolower (const unsigned char); + +extern struct cb_text_list * +cb_text_list_add (struct cb_text_list *list, const char *text); + #endif /* CB_COBC_H */ diff --git a/cobc/codegen.c b/cobc/codegen.c index f32391606..3886e3b47 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -19,6 +19,7 @@ along with GnuCOBOL. If not, see . */ +#include "libcob/common.h" #include "tarstamp.h" #include "config.h" @@ -4295,6 +4296,91 @@ 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"; + + +/* 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) +{ + static char procedure_name[COB_NORMAL_BUFF]; + + if (paragraph){ + sprintf (procedure_name, "%s|%s|%s:%d", section->name, paragraph->name, + paragraph->common.source_file, paragraph->common.source_line); + } else { + sprintf (procedure_name, "%s||%s:%d", section->name, + section->common.source_file, section->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) +{ + const char* prof_call_name; + const char* name; + cb_tree cb_str; + int declare_procedure = 0; + + 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; + break; + case COB_PROF_ENTER_PARAGRAPH: + prof_call_name = cob_prof_enter_paragraph_str; + declare_procedure = 1; + break; + case COB_PROF_ENTER_SECTION: + prof_call_name = cob_prof_enter_section_str; + paragraph = NULL; + declare_procedure = 1; + break; + } + + 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); +} + +/* Returns the index of the procedure in the procedures_list, or -1 if not found */ +static int +get_procedure_idx (const char* text) +{ + struct cb_text_list *l = procedures_list; + int i = 0; + + while (!!l) { + if (!strcmp (text, l->text)) { + return i; + } + l = l->next; + i++; + } + + return -1; +} + static void output_funcall (cb_tree x) { @@ -4310,6 +4396,17 @@ output_funcall (cb_tree x) return; } + if ( cb_flag_prof && ( + 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; + } + + screenptr = p->screenptr; output ("%s (", p->name); for (i = 0; i < p->argc; i++) { @@ -7874,6 +7971,20 @@ output_goto_1 (cb_tree x) output_move (cb_space, cb_debug_contents); } + 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 ("goto %s%d;", CB_PREFIX_LABEL, lb->id); } @@ -12183,6 +12294,9 @@ 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); + } if (cb_flag_stack_extended) { /* entry marker = first frameptr is the one with an empty (instead of NULL) section name */; @@ -13612,6 +13726,31 @@ output_header (const char *locbuff, const struct cb_program *cp) } } +static void +output_cob_prof_data () +{ + struct cb_text_list *l = procedures_list; + + output_local ("/* cob_prof data */\n\n"); + + output_local ("#include \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 (" \"\""); + output_local ("};\n"); + + output_local ("static struct cobprof_info *prof_info;\n"); + + output_local ("\n/* End of cob_prof data */\n"); + + procedures_list = NULL; + procedures_list_len = 0; +} + void codegen (struct cb_program *prog, const char *translate_name) { @@ -13888,6 +14027,8 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) output_local_base_cache (); output_local_field_cache (prog); + if (cb_flag_prof) output_cob_prof_data (); + /* Report data fields */ if (prog->report_storage) { comment_gen = 0; diff --git a/cobc/flag.def b/cobc/flag.def index 4850daa60..443a0c7f0 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -254,3 +254,6 @@ CB_FLAG_ON (cb_diagnostics_show_caret, 1, "diagnostics-show-caret", CB_FLAG_ON (cb_diagnostics_show_line_numbers, 1, "diagnostics-show-line-numbers", _(" -fno-diagnostics-show-line-numbers\tsuppress display of line numbers in diagnostics")) + +CB_FLAG (cb_flag_prof, 1, "prof", + _(" -fprof enable profiling of the COBOL program")) diff --git a/cobc/parser.y b/cobc/parser.y index b77193c93..6d7bff907 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -407,6 +407,15 @@ emit_statement (cb_tree x) } } +static COB_INLINE COB_A_INLINE void +emit_prof_call (enum cb_prof_call prof_call) +{ + if (cb_flag_prof) { + emit_statement ( + cb_build_prof_call (prof_call, current_section, current_paragraph)); + } +} + static void begin_statement_internal (enum cob_statement statement, const unsigned int term, const char *file, const int line) @@ -10927,12 +10936,14 @@ procedure_division: if (current_paragraph->exit_label) { emit_statement (current_paragraph->exit_label); } + emit_prof_call (COB_PROF_EXIT_PARAGRAPH); emit_statement (cb_build_perform_exit (current_paragraph)); } if (current_section) { if (current_section->exit_label) { emit_statement (current_section->exit_label); } + emit_prof_call (COB_PROF_EXIT_SECTION); emit_statement (cb_build_perform_exit (current_section)); } } @@ -10959,6 +10970,8 @@ procedure_division: emit_statement (CB_TREE (current_section)); label = cb_build_reference ("MAIN PARAGRAPH"); current_paragraph = CB_LABEL (cb_build_label (label, NULL)); + emit_prof_call (COB_PROF_ENTER_SECTION); + emit_prof_call (COB_PROF_ENTER_PARAGRAPH); current_paragraph->flag_declaratives = !!in_declaratives; current_paragraph->flag_skip_label = !!skip_statements; current_paragraph->flag_dummy_paragraph = 1; @@ -10969,6 +10982,10 @@ procedure_division: statements _dot_or_else_area_a _procedure_list + { + emit_prof_call (COB_PROF_EXIT_PARAGRAPH); + emit_prof_call (COB_PROF_EXIT_SECTION); + } ; _procedure_using_chaining: @@ -11244,6 +11261,7 @@ _procedure_declaratives: if (current_paragraph->exit_label) { emit_statement (current_paragraph->exit_label); } + emit_prof_call (COB_PROF_EXIT_PARAGRAPH); emit_statement (cb_build_perform_exit (current_paragraph)); current_paragraph = NULL; } @@ -11252,6 +11270,7 @@ _procedure_declaratives: emit_statement (current_section->exit_label); } current_section->flag_fatal_check = 1; + emit_prof_call (COB_PROF_EXIT_SECTION); emit_statement (cb_build_perform_exit (current_section)); current_section = NULL; } @@ -11328,12 +11347,14 @@ section_header: if (current_paragraph->exit_label) { emit_statement (current_paragraph->exit_label); } + emit_prof_call (COB_PROF_EXIT_PARAGRAPH); emit_statement (cb_build_perform_exit (current_paragraph)); } if (current_section) { if (current_section->exit_label) { emit_statement (current_section->exit_label); } + emit_prof_call (COB_PROF_EXIT_SECTION); emit_statement (cb_build_perform_exit (current_section)); } if (current_program->flag_debugging && !in_debugging) { @@ -11358,6 +11379,7 @@ section_header: _use_statement { emit_statement (CB_TREE (current_section)); + emit_prof_call (COB_PROF_ENTER_SECTION); } ; @@ -11381,6 +11403,7 @@ paragraph_header: if (current_paragraph->exit_label) { emit_statement (current_paragraph->exit_label); } + emit_prof_call (COB_PROF_EXIT_PARAGRAPH); emit_statement (cb_build_perform_exit (current_paragraph)); if (current_program->flag_debugging && !in_debugging) { emit_statement (cb_build_comment ( @@ -11400,6 +11423,7 @@ paragraph_header: current_section->flag_skip_label = !!skip_statements; current_section->xref.skip = 1; emit_statement (CB_TREE (current_section)); + emit_prof_call (COB_PROF_ENTER_SECTION); } current_paragraph = CB_LABEL (cb_build_label ($1, current_section)); current_paragraph->flag_declaratives = !!in_declaratives; @@ -11407,6 +11431,7 @@ paragraph_header: current_paragraph->flag_real_label = !in_debugging; current_paragraph->segment = current_section->segment; emit_statement (CB_TREE (current_paragraph)); + emit_prof_call (COB_PROF_ENTER_PARAGRAPH); } ; @@ -11509,6 +11534,7 @@ statements: current_section->flag_declaratives = !!in_declaratives; current_section->xref.skip = 1; emit_statement (CB_TREE (current_section)); + emit_prof_call (COB_PROF_ENTER_SECTION); } if (!current_paragraph) { cb_tree label = cb_build_reference ("MAIN PARAGRAPH"); @@ -11522,6 +11548,7 @@ statements: current_paragraph->flag_dummy_paragraph = 1; current_paragraph->xref.skip = 1; emit_statement (CB_TREE (current_paragraph)); + emit_prof_call (COB_PROF_ENTER_PARAGRAPH); } if (check_headers_present (COBC_HD_PROCEDURE_DIVISION, 0, 0, 0) == 1) { if (current_program->prog_type == COB_MODULE_TYPE_PROGRAM) { @@ -16739,7 +16766,10 @@ _end_start: /* STOP statement */ -stop: STOP { check_non_area_a ($1); }; +stop: STOP + { + check_non_area_a ($1); + }; stop_statement: stop RUN { diff --git a/cobc/tree.h b/cobc/tree.h index 5fb72a3fb..0d879d2f7 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -2597,6 +2597,18 @@ extern void codegen (struct cb_program *, const char *); extern void clear_local_codegen_vars (void); extern int cb_wants_dump_comments; /* likely to be removed later */ + +enum cb_prof_call { + COB_PROF_EXIT_PARAGRAPH, + COB_PROF_EXIT_SECTION, + COB_PROF_ENTER_PARAGRAPH, + COB_PROF_ENTER_SECTION +}; + +extern cb_tree cb_build_prof_call (enum cb_prof_call prof_fun, + struct cb_label *section, + struct cb_label *paragraph); + #define CB_MEMCHK_NONE 0 #define CB_MEMCHK_POINTER (1 << 0) #define CB_MEMCHK_USING (1 << 1) diff --git a/configure.ac b/configure.ac index 477f877ce..51bb9df5d 100644 --- a/configure.ac +++ b/configure.ac @@ -982,8 +982,6 @@ AS_IF([test "$with_xml2" = yes -o "$with_xml2" = check], [ LIBS="$curr_libs"; CPPFLAGS="$curr_cppflags" ]) - - # Checks for cjson/json-c. AC_MSG_NOTICE([Checks for JSON handler]) @@ -1080,7 +1078,8 @@ AS_IF([test "$USE_JSON" = "cjson" -o "$USE_JSON" = "local" -o "$USE_JSON" = chec #endif #if (CJSON_VERSION_MAJOR * 100 + CJSON_VERSION_MINOR) < 103 #error Needs at least cJSON 1.3.0 - #endif]], + #endif + ]], [[cJSON_CreateNull ();]])], [AC_MSG_RESULT([yes]) AC_DEFINE([WITH_CJSON], [1]) @@ -1168,7 +1167,6 @@ case "$USE_JSON" in ;; esac - AC_ARG_WITH([dl], [AS_HELP_STRING([--with-dl], [(GnuCOBOL) Use system dynamic loader (default)])], diff --git a/doc/ChangeLog b/doc/ChangeLog index 6370af4f0..77aded81c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,7 @@ +2023-09-07 Emilien Lemaire + + * gnucobol.texi: document the profiling feature + 2023-07-10 Simon Sobisch diff --git a/doc/gnucobol.texi b/doc/gnucobol.texi index a0ff783b6..2da1823a6 100644 --- a/doc/gnucobol.texi +++ b/doc/gnucobol.texi @@ -87,6 +87,7 @@ Welcome to the GnuCOBOL @value{VERSION} manual. * Customize:: Customizing the compiler * Optimize:: Optimizing your program * Debug:: Debugging your program +* Profiling:: Profiling your program * Extensions:: Non-standard extensions * System Routines:: Additional routines * Appendices:: List of supported features and options, @@ -155,6 +156,11 @@ Debug * Core Dumps:: Core Dumps * Trace:: Tracing execution +Profiling +* Profiling option:: Profiling options +* Profiling results:: Profiling results +* Profiling C interface:: C functions for profiling + Extensions * SELECT:: SELECT ASSIGN TO. @@ -1688,7 +1694,7 @@ machine. Set the config option @code{binary-byteorder} to In addition, setting the option @code{binary-size} to @code{2-4-8} or @code{1-2-4-8} is more efficient than others. -@node Debug, Extensions, Optimize, Top +@node Debug, Profiling, Optimize, Top @chapter Debug @menu @@ -1749,7 +1755,145 @@ Tracing program execution, either in general or in specific parts can be enabled @exampleindent 0 -@node Extensions, System Routines, Debug, Top +@node Profiling, Extensions, Debug, Top +@chapter Profiling COBOL +@cindex Profiling +@cindex Profiling your program + +@menu +* Profiling option:: Enabling profiling +* Profiling results:: Interpreting the results +* C interface:: Customize your profiling functions +@end menu + +@node Profiling option +@section @code{-fprof} flag +@cindex @code{-fprof} + +Profiling is enabled with the @code{-fprof} flag while compiling +your COBOL program. Then you can just execute your program and +a @code{prof.csv} or @code{prof.xlsx} file will be generated. + +@subsection Enabling xlsx result generation. + +The @code{prof.xlsx} file will be generated if when GnuCOBOL was compiled the +@code{libxlsxwritter} was found. If you do not want to generate the results +in xlsx format, and use csv instead, you can pass the @code{--with-xlsx=no} +to the @code{configure} script. + +@node Profiling results +@section Profiling results +@cindex Profiling results +@cindex How to interpret the profiling results + +The generated file, no matter its format, will have four columns: @code{Section}, +@code{Paragraph}, @code{Time (ns)}, @code{Explicit section time (ns)}. + +All the time values are in nanoseconds. + +The @code{Section} column contains the name of the section that is profiled. + +The @code{Paragraph} column contains the name of the paragraph that is profiled. + +The @code{Time (ns)} column contains the total time spend in each paragrpah, +either when it was executed by a @code{PERFORM}, a @code{GO TO}, or in the +normal flow of the program. For rows with only section name it is then +the sum of all the time spent in each of its paragraph. + +The @code{Explicit section time (ns)} column is the total time spent in +a section after a call to @code{PERFORM @var{section}} or +@code{GO TO @var{section}}. +A call to a paragraph in the section from another section is not counted +in this time. + +@subsection Consideration for @code{GO TO} + +When executing a @code{GO TO} that targets a section or a paragraph +outside of the current section, the profiler consider that you exited +every paragraphs and sections that were called before the @code{GO TO}. + +If the @code{GO TO} targets a paragraph inside the current section, +then all the previous paragraph are exited but not the current section. + +@node Profiling C interface +@section C interface for profiling +@cindex Profiling C interface +@cindex The C profiling functions + +The profiling functions are declared in 'libcob/cobprof.h' and defined in +'libcob/cobprof.c'. The interface has 7 exposed functions: +@table @code + +@item void cob_prof_init(long(*)[255], const char **, size_t, const char*(*)[255], size_t); + +@item void cob_prof_enter_paragraph(const char*, const char*); + +@item void cob_prof_exit_paragraph(const char*, const char*); + +@item void cob_prof_enter_section(const char*); + +@item void cob_prof_exit_section(const char*); + +@item void cob_prof_goto(const char*, const char*); + +@item void cob_prof_end(void); +@end table + +As these functions are declared as @code{extern}, you can override them with +your own functions. You will find below the documentation for each function +arguments and when they are called. + +@subsection @code{cob_prof_init} + +This function is executed before the first section of the program. The +arguments are given to avoid any allocation during the profiling of your +program, and correspond to the following values: + +@itemize @bullet + +@item @code{long(*)[255]}: This first argument is an 2 dimension array that +aims to contain the times spent in each section and pragraphs. +The first dimension correspond to the number of sections in the program +the second dimension is fixed at 255, and each index correspond to a paragraph +in the section. The index 254 of the second dimension is reserved for the +section time. + +@item @code{const char**, size_t}: These two arguments correspond to an array +containing all the names of the sections of the program, and the size of the +said array. + +@item @code{const char *(*)[255], size_t}: These two arguments correspond to an +array of paragraphs per section, the maximum number of paragraphs that can be found +for any section. +The index of each section correspond to the index of the name of this section +from the previous arguments. + +@end itemize + +@subsection @code{cob_prof_enter_paragraph} and @code{cob_prof_exit_paragraph} + +These two functions are executed before any code in each paragraph and when the +paragraph is explicitly or implicitly exited, respectively. + +The arguments of these functions are the name of the section containing the +paragraph and the name of the paragraph. + +@subsection @code{cob_prof_enter_section} and @code{cob_prof_exit_section} + +These two functions are executed before any code in each section and when the +section is explicitly or implicitly exited, respectively. + +The @code{enter} function is not executed when a paragraph is entered through +another section, but either when the section is explicitly called, or implicitly +when the section is the entry point of your program. + +The argument of each function correspond to the name of the section. + +@subsection @code{cob_perf_end} + +This function is executed just before the program ends and exits. It takes no argument. + +@node Extensions, System Routines, Profiling, Top @chapter Non-standard extensions @cindex Extensions @cindex Non-standard extensions diff --git a/libcob/ChangeLog b/libcob/ChangeLog index c47fc3186..b027157f6 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,3 +1,15 @@ +2023-09-04 Emilien Lemaire + + * Makefile.am: add `cobprof.c` and `cobprof.h` in sources and headers + * cobprof.c, cobprof.h: implement profiling functions (time spent in each + procedure of the program) + * common.c: include `cobprof.h` + * common.c: add `cob_get_monotonic_time`, used to get the time during + profiling, and `cob_monotonic_time_diff` and `cob_monotonic_time_sum` for + duration calculations + * common.h: add `struct cob_monotonic_time`, used for the timing in the + profiling tool, and the declarations of `cob_get_monotonic_time` and + `cob_get_monotonic_time_diff` and `cob_get_monotonic_time_sum` 2023-07-28 Simon Sobisch diff --git a/libcob/Makefile.am b/libcob/Makefile.am index ce5a4a5cc..7ce61051d 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -22,7 +22,7 @@ lib_LTLIBRARIES = libcob.la libcob_la_SOURCES = common.c move.c numeric.c strings.c \ fileio.c call.c intrinsic.c termio.c screenio.c reportio.c cobgetopt.c \ - mlio.c coblocal.h cconv.c system.def + mlio.c coblocal.h cconv.c system.def profiling.c if LOCAL_CJSON nodist_libcob_la_SOURCES = cJSON.c @@ -42,7 +42,7 @@ libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 6:0:2 -no-undefined AM_LDFLAGS = $(COB_FIX_LIB) pkgincludedir = $(includedir)/libcob -pkginclude_HEADERS = common.h version.h cobgetopt.h \ +pkginclude_HEADERS = common.h version.h cobgetopt.h cobprof.h \ exception.def exception-io.def statement.def # Add rules for code-coverage testing, as provided by AX_CODE_COVERAGE diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 835f972fe..5b53005f0 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -347,6 +347,10 @@ typedef struct __cob_settings { FILE *cob_dump_file; /* FILE* to write DUMP information to */ char *cob_dump_filename; /* Place to write dump of variables */ + char *cob_prof_filename; /* Place to write profiling data */ + int cob_prof_disable; /* Whether profiling is disabled */ + int cob_prof_max_depth; /* Max stack depth during profiling (255 by default) */ + int cob_testsuite_mode; /* Running in testsuite mode */ int cob_dump_width; /* Max line width for dump */ unsigned int cob_core_on_error; /* signal handling and possible raise of SIGABRT / creation of coredumps on runtime errors */ @@ -441,6 +445,7 @@ COB_HIDDEN void cob_init_call (cob_global *, cob_settings *, const int); COB_HIDDEN void cob_init_intrinsic (cob_global *); COB_HIDDEN void cob_init_strings (cob_global *); COB_HIDDEN void cob_init_move (cob_global *, cob_settings *); +COB_HIDDEN void cob_init_prof (cob_global *, cob_settings *); COB_HIDDEN void cob_init_screenio (cob_global *, cob_settings *); COB_HIDDEN void cob_init_mlio (cob_global * const); diff --git a/libcob/cobprof.h b/libcob/cobprof.h new file mode 100644 index 000000000..0676fbedb --- /dev/null +++ b/libcob/cobprof.h @@ -0,0 +1,61 @@ +/* + Copyright (C) 2023 Free Software Foundation, Inc. + Written by Emilien Lemaire + + This file is part of GnuCOBOL. + + The GnuCOBOL compiler is free software: you can redistribute it + and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + GnuCOBOL is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GnuCOBOL. If not, see . +*/ + +#ifndef cob_prof_h +#define cob_prof_h + +#include +#include "common.h" + +/* Type to store nanoseconds */ +typedef unsigned long long cob_ns_time; + +/* Structure storing profiling information about each COBOL module */ +struct cobprof_info { + const char* program_id ; + cob_ns_time * total_times ; /* Array of execution times */ + unsigned int * called_count ; /* Array of execution counts */ + const char** procedures_names ; /* Array of procedures names */ + size_t procedures_count; /* Number of procedures */ + int active; /* Whether profiling is active for this module */ +}; + +/* Function called to start profiling a COBOL module. Allocates the + cobprof_info structure that will be used to store the counters and + times. */ +COB_EXPIMP struct cobprof_info *cob_prof_init ( + const char *program_id, + const char**procedures_names, + size_t procedures_count); + +/* Functions used to instrument the generated C code and measure + * counters and times */ +COB_EXPIMP void cob_prof_enter_paragraph (struct cobprof_info *, int); +COB_EXPIMP void cob_prof_exit_paragraph (struct cobprof_info *, int); +COB_EXPIMP void cob_prof_enter_section (struct cobprof_info *, int); +COB_EXPIMP void cob_prof_exit_section (struct cobprof_info *, int); +COB_EXPIMP void cob_prof_goto (struct cobprof_info *, int); + +/* Function called by the runtime at the end of execution to save the + * profiling information in a file. */ +COB_EXPIMP void cob_prof_end (void); + +#endif + diff --git a/libcob/common.c b/libcob/common.c index eef27ffc1..0d5440f84 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -18,6 +18,7 @@ along with GnuCOBOL. If not, see . */ +#include "common.h" #include "tarstamp.h" #include "config.h" @@ -161,6 +162,7 @@ /* include internal and external libcob definitions, forcing exports */ #define COB_LIB_EXPIMP #include "coblocal.h" +#include "cobprof.h" #include "cobgetopt.h" @@ -495,6 +497,10 @@ static struct config_tbl gc_conf[] = { {"COB_CORE_ON_ERROR", "core_on_error", "0", coeopts, GRP_MISC, ENV_UINT | ENV_ENUMVAL, SETPOS (cob_core_on_error)}, {"COB_CORE_FILENAME", "core_filename", "./core.libcob", NULL, GRP_MISC, ENV_STR, SETPOS (cob_core_filename)}, {"COB_DUMP_FILE", "dump_file", NULL, NULL, GRP_MISC, ENV_FILE, SETPOS (cob_dump_filename)}, + {"COB_PROF_FILE", "prof_file", NULL, NULL, GRP_MISC, ENV_FILE, SETPOS (cob_prof_filename)}, + {"COB_PROF_DISABLE", "prof_disable", "0", NULL, GRP_MISC, ENV_BOOL, SETPOS (cob_prof_disable)}, + {"COB_PROF_MAX_DEPTH", "prof_max_depth", "255", NULL, GRP_MISC, ENV_UINT, SETPOS (cob_prof_max_depth)}, + {"COB_IS_RUNNING_IN_TESTMODE", "testsuite_mode", "0", NULL, GRP_MISC, ENV_BOOL, SETPOS (cob_testsuite_mode)}, {"COB_DUMP_WIDTH", "dump_width", "100", NULL, GRP_MISC, ENV_UINT, SETPOS (cob_dump_width)}, #ifdef _WIN32 /* checked before configuration load if set from environment in cob_common_init() */ @@ -907,7 +913,7 @@ cob_get_source_line () } /* reentrant version of strerror */ -static char * +char * cob_get_strerror (void) { size_t size; @@ -3015,6 +3021,7 @@ call_exit_handlers_and_terminate (void) h = h->next; } } + cob_prof_end(); cob_terminate_routines (); } @@ -10161,6 +10168,7 @@ cob_init (const int argc, char **argv) cob_init_numeric (cobglobptr); cob_init_strings (cobglobptr); cob_init_move (cobglobptr, cobsetptr); + cob_init_prof (cobglobptr, cobsetptr); cob_init_intrinsic (cobglobptr); cob_init_fileio (cobglobptr, cobsetptr); cob_init_call (cobglobptr, cobsetptr, check_mainhandle); diff --git a/libcob/common.h b/libcob/common.h index c01965eff..77b03d04e 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1645,6 +1645,7 @@ COB_EXPIMP int cob_last_exception_is (const int); COB_EXPIMP int cob_last_exit_code (void); COB_EXPIMP const char* cob_last_runtime_error (void); +COB_EXPIMP char* cob_get_strerror (void); COB_EXPIMP void cob_runtime_hint (const char *, ...) COB_A_FORMAT12; COB_EXPIMP void cob_runtime_error (const char *, ...) COB_A_FORMAT12; diff --git a/libcob/profiling.c b/libcob/profiling.c new file mode 100644 index 000000000..9f535cdf3 --- /dev/null +++ b/libcob/profiling.c @@ -0,0 +1,488 @@ +/* + Copyright (C) 2003-2023 Free Software Foundation, Inc. + Written by Emilien Lemaire + + This file is part of GnuCOBOL. + + The GnuCOBOL compiler is free software: you can redistribute it + and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + GnuCOBOL is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GnuCOBOL. If not, see . +*/ + +#include +#include +#include +#include +#include + +/* include internal and external libcob definitions, forcing exports */ +#define COB_LIB_EXPIMP +#include "coblocal.h" + +#include "tarstamp.h" +#include "config.h" +#include "common.h" +#include "cobprof.h" + +#include +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef _WIN32 +#define WIN32_LEAN_AND_MEAN +#include +#undef MOUSE_MOVED +#include +#include +#include /* for _O_BINARY only */ +#endif + +/* +Simon: As we do have a single file in the runtime for this feature - +please use it to give an outline how the profiling works (an overview +and which function is called where/why, maybe similar to what +strings.c has before cob_string_init; each function should get a doc +comment which may also provide more detailed information). + +Simon: What happens if we have more than 255 (which should be a +#define'd constant) procedures active in the runtime unit? Would it +be reasonable to have that attached to the cob_module, which may +allows to set pass the module's max in an allocating function to +libcob? + +And, as a "general" thought: instead of resolving the "textual" data +in libcob and storing it there, this part should likely be postponed +until there's an actual write to the profiling file (when all the +section/paragraph/location info can be requested/read). Switching to +this approach should both save memory during collection and reduce the +profiling overhead. + + */ + + +/* Local types and variables */ + +struct cobprof_info_list { + struct cobprof_info *info ; + struct cobprof_info_list *next; +}; + +static struct cobprof_info_list *prof_info_list ; + +#define PROF_DEFAULT_DEPTH 255 +#define PROF_MAX_DEPTH 10000000 +static int max_prof_depth = PROF_DEFAULT_DEPTH; +static cob_ns_time *start_times; +static int *called_procedures; +static struct cobprof_info* *called_runtimes; +static int current_idx = -1; +static int is_active = 1; /* we may want to disable profiling globally */ +static int is_test = 0; +static const char* prof_program_id; + +static cob_global *cobglobptr = NULL; +static cob_settings *cobsetptr = NULL; + + + + +static cob_ns_time +get_ns_time (void) +{ + static cob_ns_time ns_time = 0; + + unsigned long long nanoseconds; +#if defined (_WIN32) + LARGE_INTEGER performance_counter; + LARGE_INTEGER performance_frequency; +#elif defined (HAVE_CLOCK_GETTIME) + struct timespec ts; +#else + clock_t c; +#endif + +#if defined (_WIN32) + QueryPerformanceCounter(&performance_counter); + QueryPerformanceFrequency(&performance_frequency); + performance_counter.QuadPart *= 1000000000; + performance_counter.QuadPart /= performance_frequency.QuadPart; + nanoseconds = performance_counter.QuadPart; +#elif defined (HAVE_CLOCK_GETTIME) + clock_gettime(CLOCK_MONOTONIC, &ts); + nanoseconds = ts.tv_sec * 1000000000 + ts.tv_nsec; +#else + c = clock(); + nanoseconds = c * 1000000000; + nanoseconds /= CLOCKS_PER_SEC; +#endif + + if (nanoseconds>ns_time) ns_time = nanoseconds; + return ns_time; +} + +static int +is_in_same_section (struct cobprof_info *info, int proc_idx1, int proc_idx2) +{ + int i = 0; + const char* name1 = info->procedures_names[proc_idx1]; + const char* name2 = info->procedures_names[proc_idx2]; + + while (name1[i]){ + if (name1[i] != name2[i]) return 0; + if (name1[i] == '|') return 1; + i++; + } + return 0; /* should never happen */ +} + +static int +is_section (struct cobprof_info *info, int proc_idx) +{ + return !!strstr (info->procedures_names[proc_idx], "||"); +} + +void cob_init_prof (cob_global *lptr, cob_settings *sptr) +{ + cobglobptr = lptr; + cobsetptr = sptr; + + is_test = cobsetptr->cob_testsuite_mode; + is_active = !cobsetptr->cob_prof_disable; + + max_prof_depth = cobsetptr->cob_prof_max_depth; + if (max_prof_depth < PROF_DEFAULT_DEPTH){ + max_prof_depth = PROF_DEFAULT_DEPTH; + } + if (max_prof_depth > PROF_MAX_DEPTH){ + max_prof_depth = PROF_MAX_DEPTH; + } + start_times = cob_malloc (max_prof_depth * sizeof(cob_ns_time)); + called_procedures = cob_malloc (max_prof_depth * sizeof(int)); + called_runtimes = cob_malloc (max_prof_depth * sizeof(struct cobprof_info*)); +} + +struct cobprof_info * +cob_prof_init (const char *program_id, + const char **procedures_names, + size_t procedures_count) +{ + + if (!prof_program_id) prof_program_id = program_id ; + + if (is_active){ + struct cobprof_info *info; + struct cobprof_info_list *item; + + info = cob_malloc (sizeof(struct cobprof_info)); + info->program_id = program_id; + info->total_times = cob_malloc ( procedures_count * sizeof(cob_ns_time) ); + info->called_count = cob_malloc ( procedures_count * sizeof(unsigned int) ); + info->procedures_names = procedures_names; + info->procedures_count = procedures_count; + info->active = 1; /* in the future, we may want to desactivate profiling on a per-module basis */ + + item = cob_malloc (sizeof(struct cobprof_info_list)); + item->info = info; + item->next = prof_info_list; + prof_info_list = item; + return info; + } + return NULL; +} + +void +cob_prof_enter_paragraph (struct cobprof_info *info, int proc_idx) +{ + cob_ns_time t; + + if (!is_active || info == NULL || !info->active) return; + + t = get_ns_time (); + + current_idx++; + if (current_idx >= max_prof_depth) { + fprintf (stderr, "[cob_prof] Profiling overflow at %d calls, aborting profiling.\n", current_idx); + is_active = 0; + return; + } + + called_procedures[current_idx] = proc_idx; + called_runtimes[current_idx] = info; + start_times[current_idx] = t; + + info->called_count[proc_idx] += 1; +} + +void +cob_prof_enter_section (struct cobprof_info *info, int proc_idx) +{ + cob_ns_time t; + + if (!is_active || info == NULL || !info->active) return; + + t = get_ns_time (); + + current_idx++; + if (current_idx >= max_prof_depth){ + fprintf (stderr, "[cob_prof] Profiling overflow at %d calls, aborting profiling.\n", current_idx); + is_active = 0; + return ; + } + + called_procedures[current_idx] = proc_idx; + called_runtimes[current_idx] = info; + start_times[current_idx] = t; + + info->called_count[proc_idx] += 1; +} + +void +cob_prof_exit_paragraph (struct cobprof_info *info, int proc_idx) +{ + cob_ns_time t; + + if (!is_active || info == NULL || !info->active) return; + + t = get_ns_time (); + + while (current_idx >= 0) { + int curr_proc = called_procedures[current_idx]; + struct cobprof_info *curr_info = called_runtimes[current_idx]; + + curr_info->total_times[curr_proc] += t - start_times[current_idx]; + current_idx--; + if (curr_proc == proc_idx && curr_info == info) return; + } +} + +void +cob_prof_exit_section (struct cobprof_info *info, int proc_idx) +{ + cob_ns_time t; + + if (!is_active || info == NULL || !info->active) return; + + t = get_ns_time (); + + while (current_idx >= 0) { + int curr_proc = called_procedures[current_idx]; + struct cobprof_info *curr_info = called_runtimes[current_idx]; + + /* Check if we exited all paragraphs entered in this + section. If we are not in the same runtime, just continue + to rewind the stack. */ + if (curr_info == info && + !is_in_same_section (info, curr_proc, proc_idx)) return; + + curr_info->total_times[curr_proc] += t - start_times[current_idx]; + current_idx--; + } +} + +/* GO TO are generated for both explicit COBOL GO TO statements and COBOL EXIT ... statements. + * We do not need to have a paragraph/section enter function since these will be executed when + * the c goto is executed, just after the targeted label. */ +void +cob_prof_goto (struct cobprof_info *info, int proc_idx) +{ + int curr_proc; + struct cobprof_info *curr_info; + + if (!is_active || info == NULL || !info->active) return; + + curr_proc = called_procedures[current_idx]; + curr_info = called_runtimes[current_idx]; + + if (info == curr_info && is_in_same_section (info, proc_idx, curr_proc)) { + while (current_idx >= 0) { + curr_info = called_runtimes[current_idx]; + curr_proc = called_procedures[current_idx]; + if (is_section (curr_info, curr_proc)) { + break; + } + cob_prof_exit_section (curr_info, curr_proc); + } + + if (is_section (info, proc_idx)) { /* GO TO current section */ + return; + } else { + cob_prof_enter_paragraph (info, proc_idx); + } + } else { + /* If not in the same section, then we exit every + * procedure before entering the targeted one. */ + while (current_idx >= 0) { + curr_info = called_runtimes[current_idx]; + curr_proc = called_procedures[current_idx]; + if (is_section (curr_info, curr_proc)) { + cob_prof_exit_section (curr_info, curr_proc); + } else { + cob_prof_exit_paragraph (curr_info, curr_proc); + } + } + + if (is_section (info, proc_idx)) { + cob_prof_enter_section (info, proc_idx); + } else { + cob_prof_enter_paragraph (info, proc_idx); + } + } +} + + +static void +print_location (FILE *file, struct cobprof_info *info, int proc_num, const char* kind) { + char buf[COB_NORMAL_BUFF]; + const char *name = info->procedures_names[proc_num]; + int len = strlen (name); + int i; + + strcpy (buf, name); + for (i=0; iprogram_id, buf, kind); +} + +static void +print_monotonic_time (FILE *file, cob_ns_time t) { + + cob_ns_time nanoseconds = t ; + unsigned int hours = 0; + unsigned int minutes = 0; + unsigned int seconds = 0; + unsigned int milliseconds = 0; + + if (nanoseconds >= 100000) { + milliseconds = t / 100000; + nanoseconds %= 100000; + } + if (milliseconds >= 1000) { + seconds = milliseconds / 1000; + milliseconds %= 1000; + } + if (seconds >= 60) { + minutes = seconds / 60; + seconds %= 60; + } + if (minutes >= 60) { + hours = minutes / 60; + minutes %= 60; + } + + fprintf (file, "%Ld,", t); + + if (hours > 0) { + fprintf (file, "%u h %u m %u s %u ms %Lu ns", hours, minutes, seconds, + milliseconds, nanoseconds); + } else if (minutes > 0) { + fprintf (file, "%u m %u s %u ms %Lu ns", minutes, seconds, milliseconds, + nanoseconds); + } else if (seconds > 0) { + fprintf (file, "%u s %u ms %Lu ns", seconds, milliseconds, nanoseconds); + } else if (milliseconds > 0) { + fprintf (file, "%u ms %Lu ns", milliseconds, nanoseconds); + } else { + fprintf (file, "%Lu ns", nanoseconds); + } +} + +void +cob_prof_end () +{ + FILE *file; + char prof_file_buf[COB_NORMAL_BUFF]; + const char* prof_filename = NULL; + + if (!cobsetptr || !is_active || !prof_program_id) return; + + while (current_idx >= 0) { + cob_prof_exit_section (called_runtimes[current_idx], called_procedures[current_idx]); + } + + prof_filename = cobsetptr->cob_prof_filename; + if (!prof_filename){ + + /* Do not use cob_sys_getpid() in case of fork() */ + int pid = getpid(); + sprintf(prof_file_buf, "%d-%s-prof.csv", pid, prof_program_id); + prof_filename = prof_file_buf; + } + + file = fopen (prof_filename, !cobsetptr->cob_unix_lf ? "w" : "wb"); + + /* XXX + + The filename should use the "normal" way filenames are +built (for example the COB_DUMP_FILE, the default name prof.csv or +cobprof.csv would be fine). Ideally it is also possible to send that +to stdout - or the error output of the process. + +Please include the PID in each line, this way it is no problem if multiple running programs write to the same file. In testmode the PID would be a constant like 1234. + +To not break the tests under MinGW, please handle COB_UNIX_LF here, too. + */ + + if (!!file) { + /* XXX + Should we wait (with a timeout) if we get a file lock (another process +writing to the file)? Should we allow multiple processes to write to +the same file in parallel? + +Keep in mind that on a production system we may have hundreds of +programs that are run in parallel; it likely won't be a good idea to +have profiling on for each of this in multiple programs, ... but we +should at least handle this "somehow gracefully". + + */ + + struct cobprof_info_list *l; + + for (l = prof_info_list ; l != NULL; l=l->next){ + + struct cobprof_info *info = l->info; + int last_section = -1; + cob_ns_time section_time = 0; + + if (!info->active) continue; + + fprintf (file, "program id,section,paragraph,location,kind,time ns,time,ncalls\n"); + for (int i = 0; i < info->procedures_count; i++) { + cob_ns_time time = is_test ? info->called_count[i] : info->total_times[i]; + print_location (file, info, i, "direct"); + if (is_section (info, i)) { + last_section = i; + section_time = time; + print_monotonic_time (file, time); + } else if (i >= 1 && is_in_same_section (info, i - 1, i)) { + print_monotonic_time (file, time); + section_time += time; + } + fprintf (file, ",%d\n", info->called_count[i]); + /* We are at the last paragraph, or the next paragraph is in a new section. */ + if (last_section >=0 && + ( i + 1 >= info->procedures_count + || (i + 1 < info->procedures_count && !is_in_same_section (info, i, i + 1)))) { + print_location (file, info, last_section, "cumul"); + print_monotonic_time (file, section_time); + fprintf (file, ",\n"); + } + } + } + fclose (file); + } else { + cob_runtime_warning (_("error '%s' during fopen(%s)"), cob_get_strerror (), prof_filename); + } + current_idx = -1; + is_active = 0; +} diff --git a/tests/ChangeLog b/tests/ChangeLog index aa1608f63..b8266d4a0 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,7 @@ +2023-09-07 Emilien Lemaire + + * testsuite.src/used_binaries.at: add testing for profiling + 2023-07-10 Simon Sobisch diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index 90d1a0e0c..89ca55866 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -125,7 +125,7 @@ AT_DATA([prog2.cob], [ ]) AT_CHECK([$COMPILE_LISTING0 -t- -free prog2.cob], [0], -[GnuCOBOL V.R.P prog2.cob +[GnuCOBOL V.R.P prog2.cob LINE .....................SOURCE............................................. @@ -411,7 +411,7 @@ AT_DATA([prog2.cob], [ ]) AT_CHECK([$COMPILE_LISTING0 -t- prog2.cob], [0], -[GnuCOBOL V.R.P prog2.cob +[GnuCOBOL V.R.P prog2.cob LINE PG/LN A...B............................................................ @@ -475,7 +475,7 @@ AT_DATA([prog3.cob], [ ]) AT_CHECK([$COMPILE_LISTING0 -t- prog3.cob], [0], -[GnuCOBOL V.R.P prog3.cob +[GnuCOBOL V.R.P prog3.cob LINE PG/LN A...B............................................................ @@ -568,7 +568,7 @@ SIZE TYPE LVL NAME PICTURE AT_CHECK([$COBC $FLAGS -E -o prog.i prog.cob], [0], [], []) AT_CHECK([$COMPILE_LISTING0 -t- -ftsymbols prog.i], [0], -[GnuCOBOL V.R.P prog.i +[GnuCOBOL V.R.P prog.i LINE PG/LN A...B............................................................ @@ -772,7 +772,7 @@ AT_DATA([prog1.cob], [ ]) AT_CHECK([$COMPILE_LISTING0 -t- -ftsymbols prog1.cob], [0], -[GnuCOBOL V.R.P prog1.cob +[GnuCOBOL V.R.P prog1.cob LINE PG/LN A...B............................................................ @@ -1459,7 +1459,7 @@ AT_DATA([prog.cob], [ ]) AT_DATA([prog17.lst], -[GnuCOBOL V.R.P prog.i +[GnuCOBOL V.R.P prog.i LINE PG/LN A...B............................................................ @@ -2250,7 +2250,7 @@ AT_DATA([prog2.cob], [ ]) AT_CHECK([$COMPILE_LISTING0 -t- -fno-tmessages -fno-tsource -ftsymbols prog2.cob], [0], -[GnuCOBOL V.R.P prog2.cob +[GnuCOBOL V.R.P prog2.cob SIZE TYPE LVL NAME PICTURE @@ -2284,7 +2284,7 @@ AT_DATA([prog3.cob], [ AT_CHECK([$COMPILE_LISTING0 -t prog.lst -fno-tsource -fno-tmessages -ftsymbols prog3.cob], [0], [], []) AT_DATA([prog15-1.lst], -[GnuCOBOL V.R.P prog3.cob +[GnuCOBOL V.R.P prog3.cob SIZE TYPE LVL NAME PICTURE @@ -5129,7 +5129,7 @@ EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL ], [ignore]) AT_CHECK([$COMPILE_LISTING0 -Xref -T- -ftsymbols EDITOR.cob], [1], -[GnuCOBOL V.R.P EDITOR.cob +[GnuCOBOL V.R.P EDITOR.cob LINE PG/LN A...B............................................................SEQUENCE diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 03e6549d1..0da12deed 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -1002,3 +1002,124 @@ AT_CHECK([$COBC -fdiagnostics-plain-output -fdiagnostics-show-caret -Wno-others AT_CLEANUP +AT_SETUP([run profiling]) +AT_KEYWORDS([cobc profiling]) + +AT_DATA([XXX], [ +this test should include a second program which is CALLed two times +and has a different code path and therefore profiling depending on a +"mode" parameter passed + +one test is missing that involves multiple COBOL programs, maybe a +module profcob1 (started by cobcrun, doing CALL "SYSTEM" USING +"profcob2" (of a compiled executable)) +]) +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + 1ST SECTION. + PARA-0001. + PERFORM PARA-0003. + PARA-0002. + CONTINUE. + PARA-0003. + GO TO 2ND. + PARA-0004. + CONTINUE. + 2ND SECTION. + PARA-0005. + PERFORM PARA-0006. + PARA-0006. + CONTINUE. + PARA-0007. + STOP RUN. +]) +AT_CAPTURE_FILE([prof.csv]) + +AT_CHECK([$COMPILE -fprof -x prog.cob], [0], [], +[prog.cob: in section '1ST': +prog.cob: in paragraph 'PARA-0003': +prog.cob:11: warning: GO TO SECTION '2ND' +]) + +AT_CHECK([COB_PROF_FILE=prof.csv ./prog]) + +#note: The time here is actually the number of times the procedure has been run, to avoid +# any indeterminism in the running time of the procedure. + +AT_CHECK([cat prof.csv], [0], +[program id,procedure,time ns,time,ncalls +prog,1ST,,prog.cob:5,direct,1,1 ns,1 +prog,1ST,PARA-0001,prog.cob:6,direct,1,1 ns,1 +prog,1ST,PARA-0002,prog.cob:8,direct,0,0 ns,0 +prog,1ST,PARA-0003,prog.cob:10,direct,1,1 ns,1 +prog,1ST,PARA-0004,prog.cob:12,direct,0,0 ns,0 +prog,1ST,,prog.cob:5,cumul,3,3 ns, +prog,2ND,,prog.cob:14,direct,2,2 ns,2 +prog,2ND,PARA-0005,prog.cob:15,direct,1,1 ns,1 +prog,2ND,PARA-0006,prog.cob:17,direct,2,2 ns,2 +prog,2ND,PARA-0007,prog.cob:19,direct,1,1 ns,1 +prog,2ND,,prog.cob:14,cumul,6,6 ns, +]) + +AT_CLEANUP + +AT_SETUP([run profiling with no name]) +AT_KEYWORDS([cobc profiling]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + DISPLAY "HELLO". + DISPLAY "WORLD". +]) +AT_CAPTURE_FILE([prof.csv]) + +AT_CHECK([$COMPILE -fprof -x prog.cob]) + +AT_CHECK([COB_PROF_FILE=prof.csv ./prog], [0], [HELLO +WORLD +]) + +AT_CHECK([cat prof.csv], [0], +[program id,procedure,time ns,time,ncalls +prog,MAIN SECTION,,prog.cob:5,direct,1,1 ns,1 +prog,MAIN SECTION,MAIN PARAGRAPH,prog.cob:5,direct,1,1 ns,1 +prog,MAIN SECTION,,prog.cob:5,cumul,2,2 ns, +]) + +AT_CLEANUP + +AT_SETUP([run profiling with no section]) +AT_KEYWORDS([cobc profiling]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + 1ST. + DISPLAY "HELLO". + 2ND. + DISPLAY "WORLD". +]) +AT_CAPTURE_FILE([prof.csv]) + +AT_CHECK([$COMPILE -fprof -x prog.cob]) + +AT_CHECK([COB_PROF_FILE=prof.csv ./prog], [0], [HELLO +WORLD +]) + +AT_CHECK([cat prof.csv], [0], +[program id,procedure,time ns,time,ncalls +prog,MAIN SECTION,,prog.cob:5,direct,1,1 ns,1 +prog,MAIN SECTION,1ST,prog.cob:5,direct,1,1 ns,1 +prog,MAIN SECTION,2ND,prog.cob:7,direct,1,1 ns,1 +prog,MAIN SECTION,,prog.cob:5,cumul,3,3 ns, +]) + +AT_CLEANUP + +