diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 0c5659e71..e4dd21355 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,3 +1,9 @@ +2023-09-04 Fabrice Le Fessant and Emilien Lemaire + + * parser.y: generate `cob_prof_section/paragraph_enter/exit` calls when + needed + * flag.def: add `-fprof` to enable profiling + * 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..4682ccda5 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -4295,6 +4295,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 +4395,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 +7970,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 +12293,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 +13725,33 @@ output_header (const char *locbuff, const struct cb_program *cp) } } +static void +output_cob_prof_data () +{ + if (cb_flag_prof) { + 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) { @@ -13887,6 +14027,7 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) output_local_base_cache (); output_local_field_cache (prog); + output_cob_prof_data (); /* Report data fields */ if (prog->report_storage) { 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..494fb991d 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) { 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/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..bceba8bfb 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,10 @@ Debug * Core Dumps:: Core Dumps * Trace:: Tracing execution +Profiling +* Profiling options:: Profiling options +* Profiling results:: Profiling results + Extensions * SELECT:: SELECT ASSIGN TO. @@ -1688,7 +1693,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 +1754,113 @@ 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 options:: Profiling options +* Profiling results:: Profiling results +@end menu + +@node Profiling options +@section Profiling options + +Profiling is enabled with the @code{-fprof} flag while compiling +your COBOL module. + +Then executing your program will automatically profile the module(s) +and generate a CSV result file. By default, this file is called +@code{-prof.csv}. + +The following environment variables (and the corresponding option in +the runtime configuration) are available to tune the behavior of +profiling during execution: + +@table @code + +@item COB_PROF_FILE (prof_file) + +This variable specifies the name of the CSV file generated at the end +of execution. + +@item COB_PROF_DISABLE (prof_disable) + +This variable disables profiling for all modules, even the ones +compiled with @code{-fprof}. + +@item COB_PROF_MAX_DEPTH (prof_max_depth) + +This variable can be used to increase the maximal number of recursions +allowed during profiling. The default (and minimal) setting is +255. The maximal is 100,000,000. If the number of recursions is +greater than the maximal depth, profiling is disabled and will not +generate any file. + +@item COB_IS_RUNNING_IN_TESTMODE (testsuite_mode) + +This variable is used when running the testsuite. The timings will be +replaced by the number of calls, to make the output deterministic. + +@end table + +@node Profiling results +@section Profiling results +@cindex Profiling results +@cindex How to interpret the profiling results + +The generated CSV file has 8 columns for each line: + +@table @code + +@item program id + +The name of the main module program identifier + +@item section + +The name of the section + +@item paragraph + +The name of the paragraph, if present + +@item location + +The file and line number of the corresponding entry point (section or +paragraph) + +@item kind + +Whether this line is a direct measurement (@code{direct}) or a +cumulative measurement (@code{cumul}), including the values of the +section and all included paragraphs. + +@item time ns + +The time spent in the section/paragraph in nanoseconds + +@item time + +The time spent in the section/paragraph in the most human readable form + +@item ncalls + +The number of calls to this section/paragraph + +@end table + +@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 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..f49c45c3b 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,3 +1,11 @@ +2023-09-04 Fabrice Le Fessant and Emilien Lemaire + + * Makefile.am: add `profiling.c` and `cobprof.h` in sources and headers + * profiling.c, cobprof.h: implement profiling functions (time spent in each + procedure of the program) + * common.c: include `cobprof.h` + * common.c: add 4 environments variables COB_PROF_FILE, COB_PROF_MAX_DEPTH, + COB_PROF_DISABLE and COB_IS_RUNNING_IN_TESTMODE 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..271291be4 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); @@ -504,6 +509,10 @@ COB_HIDDEN cob_settings *cob_get_settings_ptr (void); COB_HIDDEN char *cob_strndup (const char *, const size_t); +/* Function called by the runtime at the end of execution to save the + * profiling information in a file. */ +COB_HIDDEN void cob_prof_end (void); + enum cob_datetime_res { DTR_DATE, DTR_TIME_NO_NANO, diff --git a/libcob/cobprof.h b/libcob/cobprof.h new file mode 100644 index 000000000..58683d3a7 --- /dev/null +++ b/libcob/cobprof.h @@ -0,0 +1,57 @@ +/* + 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); + +#endif + diff --git a/libcob/common.c b/libcob/common.c index eef27ffc1..56c9ad8a1 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -495,6 +495,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 +911,7 @@ cob_get_source_line () } /* reentrant version of strerror */ -static char * +char * cob_get_strerror (void) { size_t size; @@ -3015,6 +3019,7 @@ call_exit_handlers_and_terminate (void) h = h->next; } } + cob_prof_end(); cob_terminate_routines (); } @@ -10161,6 +10166,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..d6519afe9 --- /dev/null +++ b/libcob/profiling.c @@ -0,0 +1,445 @@ +/* + Copyright (C) 2003-2023 Free Software Foundation, Inc. + Written by Emilien Lemaire and Fabrice Le Fessant. + + 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 + +/* 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"); + + if (!!file) { + + 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; + cob_ns_time section_cumul_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; + section_cumul_time = 0; + print_monotonic_time (file, time); + } else if (i >= 1 && is_in_same_section (info, i - 1, i)) { + print_monotonic_time (file, time); + section_cumul_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 > section_cumul_time ? section_time : section_cumul_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/used_binaries.at b/tests/testsuite.src/used_binaries.at index 03e6549d1..f2fc10f48 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,section,paragraph,location,kind,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,2,2 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,4,4 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,section,paragraph,location,kind,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,1,1 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,section,paragraph,location,kind,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,2,2 ns, +]) + +AT_CLEANUP + +