diff options
Diffstat (limited to 'gcc/cobol/gengen.cc')
| -rw-r--r-- | gcc/cobol/gengen.cc | 591 |
1 files changed, 285 insertions, 306 deletions
diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index 91f67d5..e42747b 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -136,6 +136,14 @@ tree bool_false_node; struct cbl_translation_unit_t gg_trans_unit; +// This set is used to prevent duplicated top-level program names from breaking +// the compiler when a source code module makes that mistake. +static std::unordered_set<std::string> names_we_have_seen; + +// This vector is used to process the function_decls at the point we leave +// the file. +static std::vector<tree> finalized_function_decls; + void gg_build_translation_unit(const char *filename) { @@ -257,14 +265,6 @@ gg_append_var_decl(tree var_decl) } } -location_t -location_from_lineno() - { - location_t loc; - loc = linemap_line_start(line_table, sv_current_line_number, 0); - return loc; - } - void gg_append_statement(tree stmt) { @@ -354,13 +354,12 @@ adjust_for_type(tree type) return retval; } -static char * -show_type(tree type) +gg_show_type(tree type) { if( !type ) { - cbl_internal_error("The given type is not NULL, and that's just not fair"); + cbl_internal_error("The given type is NULL, and that is just not fair"); } if( DECL_P(type) ) @@ -369,14 +368,17 @@ show_type(tree type) } if( !TYPE_P(type) ) { - cbl_internal_error("The given type is not a DECL or a TYPE"); + cbl_internal_error("The given type is not a declaration or a TYPE"); } - static char ach[1024]; + static char ach[1100]; + static char ach2[1024]; + static char ach3[1024]; switch( TREE_CODE(type) ) { case POINTER_TYPE: - sprintf(ach, "POINTER"); + strcpy(ach2, gg_show_type(TREE_TYPE(type))); + sprintf(ach, "POINTER to %s", ach2); break; case VOID_TYPE: @@ -405,11 +407,8 @@ show_type(tree type) break; case FUNCTION_TYPE: - sprintf(ach, "FUNCTION"); -// sprintf(ach, -// "%3ld-bit %s INT", -// TREE_INT_CST_LOW(TYPE_SIZE(type)), -// (TYPE_UNSIGNED(type) ? "unsigned" : " signed")); + strcpy(ach3, gg_show_type(TREE_TYPE(type))); + sprintf(ach, "FUNCTION returning %s", ach3); break; default: @@ -419,7 +418,7 @@ show_type(tree type) return ach; } -void +tree gg_assign(tree dest, const tree source) { // This does the equivalent of a C/C++ "dest = source". When X1 is set, it @@ -430,6 +429,7 @@ gg_assign(tree dest, const tree source) // This routine also provides for the possibility that the assignment is // for a source that is a function invocation, as in // "dest = function_call()" + tree stmt = NULL_TREE; saw_pointer = false; tree dest_type = adjust_for_type(TREE_TYPE(dest)); @@ -452,11 +452,11 @@ gg_assign(tree dest, const tree source) if( okay ) { - tree stmt = build2_loc( location_from_lineno(), - MODIFY_EXPR, - TREE_TYPE(dest), - dest, - source); + stmt = build2_loc(location_from_lineno(), + MODIFY_EXPR, + TREE_TYPE(dest), + dest, + source); gg_append_statement(stmt); } else @@ -465,20 +465,25 @@ gg_assign(tree dest, const tree source) // the same. This is a compilation-time error, since we want the caller to // have sorted the types out explicitly. If we don't throw an error here, // the gimple reduction will do so. Better to do it here, when we know - // where we are. - dbgmsg("Inefficient assignment"); - if(DECL_P(dest) && DECL_NAME(dest)) + // where we are.S + static const int debugging = 1; + if( debugging ) { - dbgmsg(" Destination is %s", IDENTIFIER_POINTER(DECL_NAME(dest))); - } - dbgmsg(" dest type is %s%s", show_type(dest_type), p2 ? "_P" : ""); - if(DECL_P(source) && DECL_NAME(source)) - { - dbgmsg(" Source is %s", IDENTIFIER_POINTER(DECL_NAME(source))); + fprintf(stderr, "Inefficient assignment\n"); + if(DECL_P(dest) && DECL_NAME(dest)) + { + fprintf(stderr, " Destination is %s\n", IDENTIFIER_POINTER(DECL_NAME(dest))); + } + fprintf(stderr, " dest type is %s%s\n", gg_show_type(dest_type), p2 ? "_P" : ""); + if(DECL_P(source) && DECL_NAME(source)) + { + fprintf(stderr, " Source is %s\n", IDENTIFIER_POINTER(DECL_NAME(source))); + } + fprintf(stderr, " source type is %s%s\n", gg_show_type(source_type), p2 ? "_P" : ""); } - dbgmsg(" source type is %s%s", show_type(source_type), p2 ? "_P" : ""); - gcc_unreachable(); + cbl_internal_error("Attempting an assignment of differing types."); } + return stmt; } tree @@ -520,8 +525,7 @@ gg_find_field_in_struct(const tree base, const char *field_name) if( !field_decl ) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### Somebody asked for the field %s.%s, which doesn't exist", + yywarn("Somebody asked for the field %s.%s, which does not exist", IDENTIFIER_POINTER(DECL_NAME(base)), field_name); gcc_unreachable(); @@ -933,7 +937,7 @@ gg_declare_variable(tree type_decl, // causes the storage to be allocated. // It is routine to let the compiler assign names to stack variables. The - // assembly code doesn't use names for variables on the stack; they are + // assembly code does not use names for variables on the stack; they are // referenced by offsets to the base pointer. But static variables have to // have names, and there are places in my code generation -- Lord only knows // why -- where I didn't give the variables explicit names. We remedy that @@ -2152,18 +2156,6 @@ gg_printf(const char *format_string, ...) int nargs = 0; tree args[ARG_LIMIT]; - // Because this routine is intended for debugging, we are sending the - // text to STDERR - - // Because we don't actually use stderr ourselves, we just pick it up as a - // VOID_P and pass it along to fprintf() - tree t_stderr = gg_declare_variable(VOID_P, "stderr", - NULL_TREE, - vs_external_reference); - - gg_push_context(); - - args[nargs++] = t_stderr; args[nargs++] = build_string_literal(strlen(format_string)+1, format_string); va_list ap; @@ -2173,8 +2165,7 @@ gg_printf(const char *format_string, ...) { if(nargs >= ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### You *must* be joking!"); + yywarn("You *must* be joking"); gcc_unreachable(); } @@ -2182,10 +2173,8 @@ gg_printf(const char *format_string, ...) { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You nitwit!"); - yywarn("You forgot to put a NULL_TREE at the end of a " - "gg_printf() again!"); - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); + yywarn("You forgot to put a %<NULL_TREE%> at the end of a " + "%<gg_printf()%> again"); gcc_unreachable(); } @@ -2197,7 +2186,7 @@ gg_printf(const char *format_string, ...) static tree function = NULL_TREE; if( !function ) { - function = gg_get_function_address(INT, "fprintf"); + function = gg_get_function_address(INT, "__gg__fprintf_stderr"); } tree stmt = build_call_array_loc (location_from_lineno(), @@ -2206,8 +2195,6 @@ gg_printf(const char *format_string, ...) nargs, args); gg_append_statement(stmt); - - gg_pop_context(); } tree @@ -2233,8 +2220,7 @@ gg_fprintf(tree fd, int nargs, const char *format_string, ...) { if(argc >= ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### You *must* be joking!"); + yywarn("You *must* be joking"); gcc_unreachable(); } @@ -2486,123 +2472,121 @@ chain_parameter_to_function(tree function_decl, const tree param_type, const ch } } -void -gg_modify_function_type(tree function_decl, tree return_type) - { - tree fndecl_type = build_varargs_function_type_array( return_type, - 0, // No parameters yet - NULL); // And, hence, no types - TREE_TYPE(function_decl) = fndecl_type; - tree resdecl = build_decl (UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, return_type); - DECL_CONTEXT (resdecl) = function_decl; - DECL_RESULT (function_decl) = resdecl; - } +/* There are five ways that we use function_decls: -tree -gg_define_function_with_no_parameters(tree return_type, - const char *funcname, - const char *unmangled_name) - { - // This routine builds a function_decl, puts it on the stack, and - // gives it a context. + 1, We define a main() entry point. + 2. We call a function that turns out to be a static "t" function local to the source code module. + 3. We define an global "T" function, and possibly call it later. + 4. We call a function that we define later in the source code module. + 5. We call a function that ends up being an extern that is not defined in the source code module. - // At this time we don't know how many parameters this function expects, so - // we set things up and we'll tack on the parameters later. + Cases 3. and 4. turn out to require the same flags. Here are the combinations of + flags that are required for each flavor of function_decl. This was empirically + determind by compiling a C++ program with sample code for each type. - // Create the FUNCTION_TYPE for that array: - // int nparams = 1; - // tree types[1] = {VOID_P}; - // const char *names[1] = {"_p1"}; + | addressable | used | nothrow | static | external | public | no_instrument +main | | | | X | | X | X +local | X | X | X | X | | | X +external defined inside | X | X | X | X | | X | X +external defined elsewhere | X | X | | | X | X | - // tree fndecl_type = build_varargs_function_type_array( return_type, - // nparams, - // types); +*/ - tree fndecl_type = build_varargs_function_type_array( return_type, - 0, // No parameters yet - NULL); // And, hence, no types - // Create the FUNCTION_DECL for that FUNCTION_TYPE - tree function_decl = build_fn_decl (funcname, fndecl_type); +static std::unordered_map<std::string, tree> map_of_function_decls; - // Some of this stuff is magical, and is based on compiling C programs - // and just mimicking the results. - TREE_ADDRESSABLE(function_decl) = 1; - TREE_STATIC(function_decl) = 1; - DECL_EXTERNAL (function_decl) = 0; - DECL_PRESERVE_P (function_decl) = 0; - DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 1; - DECL_ARTIFICIAL(function_decl) = 0; - TREE_NOTHROW(function_decl) = 0; - TREE_USED(function_decl) = 1; +static +std::string function_decl_key(const char *funcname, tree fndecl_type) + { + std::string retval; + retval += funcname; + retval += gg_show_type(TREE_TYPE(fndecl_type)); + return retval; + } - // This code makes COBOL nested programs actual visible on the - // source code "trans_unit_decl" level, but with non-public "static" - // visibility. - if( gg_trans_unit.function_stack.size() == 0 ) +tree +gg_peek_fn_decl(const char *funcname, tree fndecl_type) + { + // When funcname is found in map_of_function_decls, this routine returns + // the type of the return value of that function decl. + + tree retval = NULL_TREE; + std::string key = function_decl_key(funcname, fndecl_type); + std::unordered_map<std::string, tree>::const_iterator it = + map_of_function_decls.find(key); + if( it != map_of_function_decls.end() ) { - // gg_trans_unit.function_stack is empty, so our context is - // the compilation module, and we need to be public: - DECL_CONTEXT (function_decl) = gg_trans_unit.trans_unit_decl; - TREE_PUBLIC(function_decl) = 1; + // This function_decl has already been defined. + retval = TREE_TYPE(TREE_TYPE(it->second)); + } + return retval; + } + +tree +gg_build_fn_decl(const char *funcname, tree fndecl_type) + { + tree function_decl; + + std::string key = function_decl_key(funcname, fndecl_type); + std::unordered_map<std::string, tree>::const_iterator it = + map_of_function_decls.find(key); + if( it != map_of_function_decls.end() ) + { + // This function_decl has already been defined. Just return it; the caller + // is responsible for modifying it, if necessary. + function_decl = it->second; } else { - // The stack has something in it, so we are building a nested function. - // Make the current function our context - DECL_CONTEXT (function_decl) = gg_trans_unit.trans_unit_decl; - TREE_PUBLIC(function_decl) = 0; - - // This function is file static, but nobody calls it, so without - // intervention -O1+ optimizations will discard it. - DECL_PRESERVE_P (function_decl) = 1; + // When creating a never-seen function_decl, we default to the type used + // for calling a function defined elsewhere. It's up to our caller to + // modify the flags, for example if this is part of creating a function. - // Append this function to the list of functions and variables - // associated with the computation module. - gg_append_var_decl(function_decl); - } + function_decl = build_fn_decl(funcname, fndecl_type); - // Establish the RESULT_DECL for the function: - tree resdecl = build_decl (location_from_lineno(), RESULT_DECL, NULL_TREE, return_type); - DECL_CONTEXT (resdecl) = function_decl; - DECL_RESULT (function_decl) = resdecl; + // These are the bits shown in the table in the comment up above + TREE_ADDRESSABLE(function_decl) = 1; + TREE_USED(function_decl) = 1; + TREE_NOTHROW(function_decl) = 0; + TREE_STATIC(function_decl) = 0; + DECL_EXTERNAL (function_decl) = 1; + TREE_PUBLIC (function_decl) = 1; + DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 0; - // The function_decl has a .function member, a pointer to struct_function. - // This is quietly, almost invisibly, extremely important. You need to - // call this routine after DECL_RESULT has been established: + DECL_PRESERVE_P (function_decl) = 0; + DECL_ARTIFICIAL(function_decl) = 0; + map_of_function_decls[key] = function_decl; + } + return function_decl; + } - allocate_struct_function(function_decl, false); +tree +gg_define_function( tree return_type, + const char *funcname, + const char *unmangled_name, + ...) + { + // This routine builds a function_decl, puts it on the stack, and + // gives it a context. - struct gg_function_t new_function = {}; - new_function.context_count = 0; - new_function.function_decl = function_decl; - new_function.our_name = IDENTIFIER_POINTER(DECL_NAME(function_decl)); - new_function.our_unmangled_name = xstrdup(unmangled_name); - new_function.function_address = gg_get_function_address(VOID, new_function.our_name); + // At this time we don't know how many parameters this function expects, so + // we set things up and we'll tack on the parameters later. - // Each program on the stack gets a unique identifier. This is used, for - // example, to make sure that static variables have unique names. - static size_t program_id = 0; - new_function.program_id_number = program_id++; + /* There is some bookkeeping we need to do to avoid crashing. - // With everything established, put this function_decl on the stack - gg_trans_unit.function_stack.push_back(new_function); + It's possible for the source code to have two top-level functions with + the same name. This is a compile-time error, but the GCC processing gets + upset when it happens. We'll prevent it from happening here: - // All we need is a context, and we are ready to go: - gg_push_context(); - return function_decl; - } + */ -void -gg_tack_on_function_parameters(tree function_decl, ...) - { int nparams = 0; tree types[ARG_LIMIT]; const char *names[ARG_LIMIT]; va_list params; - va_start(params, function_decl); + va_start(params, unmangled_name); for(;;) { tree var_type = va_arg(params, tree); @@ -2615,10 +2599,8 @@ gg_tack_on_function_parameters(tree function_decl, ...) { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You nitwit!"); - yywarn("You forgot to put a NULL_TREE at the end of a " - "gg_define_function() again!"); - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); + yywarn("You forgot to put a %<NULL_TREE%> at the end of a " + "%<gg_define_function()%> again"); gcc_unreachable(); } @@ -2629,88 +2611,33 @@ gg_tack_on_function_parameters(tree function_decl, ...) nparams += 1; if(nparams > ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### %d parameters? Really? Are you insane?",ARG_LIMIT+1); + yywarn("%d parameters? Really? Are you insane?", ARG_LIMIT+1); gcc_unreachable(); } } va_end(params); - // Chain the names onto the variables list: - for(int i=0; i<nparams; i++) + std::unordered_set<std::string>::const_iterator it = + names_we_have_seen.find(funcname); + if( it != names_we_have_seen.end() ) { - chain_parameter_to_function(function_decl, types[i], names[i]); + static int bum_counter = 1; + // We have seen this name before. Replace it with something unique: + char ach[32]; + sprintf(ach, "..no_dupes.%d", bum_counter++); + funcname = ach; } - } - -void -gg_define_function(tree return_type, const char *funcname, ...) - { - // This routine builds a function_decl, puts it on the stack, and - // gives it a context. - - // After the funcname, we expect the formal parameters: pairs of types/names - // terminated by a NULL_TREE - - int nparams = 0; - - tree types[ARG_LIMIT]; - const char *names[ARG_LIMIT]; - - va_list params; - va_start(params,funcname); - for(;;) + else { - tree var_type = va_arg(params, tree); - if( !var_type ) - { - break; - } - - if( TREE_CODE(var_type) >= NUM_TREE_CODES) - { - // Warning: This test is not completely reliable, because a garbage - // byte could have a valid TREE_CODE. But it does help. - yywarn("You nitwit!"); - yywarn("You forgot to put a NULL_TREE at the end of a " - "gg_define_function() again!"); - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - gcc_unreachable(); - } - - const char *name = va_arg(params, const char *); - - types[nparams] = var_type; - names[nparams] = name; - nparams += 1; - if(nparams > ARG_LIMIT) - { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### %d parameters? Really? Are you insane?", - ARG_LIMIT+1); - gcc_unreachable(); - } + names_we_have_seen.insert(funcname); } - va_end(params); - // Create the FUNCTION_TYPE for that array: tree fndecl_type = build_varargs_function_type_array( return_type, nparams, types); // Create the FUNCTION_DECL for that FUNCTION_TYPE - tree function_decl = build_fn_decl (funcname, fndecl_type); - - // Some of this stuff is magical, and is based on compiling C programs - // and just mimicking the results. - TREE_ADDRESSABLE(function_decl) = 1; - TREE_STATIC(function_decl) = 1; - DECL_EXTERNAL (function_decl) = 0; - DECL_PRESERVE_P (function_decl) = 0; - DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 1; - DECL_ARTIFICIAL(function_decl) = 0; - TREE_NOTHROW(function_decl) = 0; - TREE_USED(function_decl) = 1; + tree function_decl = gg_build_fn_decl (funcname, fndecl_type); // This code makes COBOL nested programs actual visible on the // source code "trans_unit_decl" level, but with non-public "static" @@ -2718,22 +2645,40 @@ gg_define_function(tree return_type, const char *funcname, ...) if( gg_trans_unit.function_stack.size() == 0 ) { // gg_trans_unit.function_stack is empty, so our context is - // the compilation module, and we need to be public: + // the compilation module, and we need to be public because this is a + // top-level function with global scope: + + // These are the bits shown in the table for gg_build_fn_decl() + TREE_ADDRESSABLE(function_decl) = 1; + TREE_USED(function_decl) = 1; + TREE_NOTHROW(function_decl) = 1; + TREE_STATIC(function_decl) = 1; + DECL_EXTERNAL (function_decl) = 0; + TREE_PUBLIC (function_decl) = 1; + DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 1; DECL_CONTEXT (function_decl) = gg_trans_unit.trans_unit_decl; - TREE_PUBLIC(function_decl) = 1; } else { - // The stack has something in it, so we are building a nested function. - // Make the current function our context + // The stack has something in it, so we are building a contained + // program-id. Such function are implemented local static functions. + // + // It's not necessarily true that a static call to such a function will be + // part of the source code (the call can be through a variable), and so + // optimization routines can decide the function isn't used and can + // therefore be optimized away. The preserve flag prevents that. + + // These are the bits shown in the table for gg_build_fn_decl() + TREE_ADDRESSABLE(function_decl) = 1; + TREE_USED(function_decl) = 1; + TREE_NOTHROW(function_decl) = 1; + TREE_STATIC(function_decl) = 1; + DECL_EXTERNAL (function_decl) = 0; + TREE_PUBLIC (function_decl) = 0; + DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 1; DECL_CONTEXT (function_decl) = gg_trans_unit.trans_unit_decl; - - // We need to make it public, because otherwise COBOL CALL "func" - // won't be able to find it, because dlopen/dlsym won't find it. - TREE_PUBLIC(function_decl) = 0; - - // Append this function to the list of functions and variables - // associated with the computation module. + DECL_CONTEXT(function_decl) = gg_trans_unit.trans_unit_decl; + DECL_PRESERVE_P (function_decl) = 1; gg_append_var_decl(function_decl); } @@ -2757,6 +2702,9 @@ gg_define_function(tree return_type, const char *funcname, ...) struct gg_function_t new_function = {}; new_function.context_count = 0; new_function.function_decl = function_decl; + new_function.our_name = IDENTIFIER_POINTER(DECL_NAME(function_decl)); + new_function.our_unmangled_name = xstrdup(unmangled_name); + new_function.function_address = gg_get_address_of(function_decl); // Each program on the stack gets a unique identifier. This is used, for // example, to make sure that static variables have unique names. @@ -2768,6 +2716,19 @@ gg_define_function(tree return_type, const char *funcname, ...) // All we need is a context, and we are ready to go: gg_push_context(); + return function_decl; + } + +void +gg_modify_function_type(tree function_decl, tree return_type) + { + tree fndecl_type = build_varargs_function_type_array( return_type, + 0, // No parameters yet + NULL); // And, hence, no types + TREE_TYPE(function_decl) = fndecl_type; + tree resdecl = build_decl (UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, return_type); + DECL_CONTEXT (resdecl) = function_decl; + DECL_RESULT (function_decl) = resdecl; } tree @@ -2799,10 +2760,8 @@ gg_get_function_decl(tree return_type, const char *funcname, ...) { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You nitwit!"); - yywarn("You forgot to put a NULL_TREE at the end of a " - "gg_define_function() again!"); - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); + yywarn("You forgot to put a %<NULL_TREE%> at the end of a " + "%<gg_define_function()%> again"); gcc_unreachable(); } @@ -2813,8 +2772,7 @@ gg_get_function_decl(tree return_type, const char *funcname, ...) nparams += 1; if(nparams > ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### %d parameters? Really? Are you insane?", + yywarn("%d parameters? Really? Are you insane?", ARG_LIMIT+1); gcc_unreachable(); } @@ -2889,63 +2847,73 @@ gg_finalize_function() // Finish off the context gg_pop_context(); - if( gg_trans_unit.function_stack.back().is_truly_nested ) - { - // This code is for true nested functions. - - ///////// DANGER, WILL ROBINSON! - ///////// This is all well and good. It does not, however, work. - ///////// I tried to implement it because I had a Brilliant Idea for - ///////// building COBOL paragraphs in a way that would easily allow - ///////// the GDB "NEXT" command to step over a PERFORM <paragraph>. - ///////// But, alas, I realized that it was just not going to work. - ///////// - ///////// Pity. - ///////// - ///////// But at that point, I was here, and I am leaving this uncooked - ///////// code in case I someday want to return to it. If it becomes - ///////// your job, rather than mine, I encourage you to write a C - ///////// program that uses the GNU extensions that allow true nested - ///////// functions, and reverse engineer the "finish_function" - ///////// function, and get it working. - ///////// - ///////// Good luck. Bob Dubner, 2022-08-13 - - // Because this is a nested function, let's make sure that it actually - // has a function that it is nested within - gcc_assert(gg_trans_unit.function_stack.size() > 1 ); - - /* Genericize before inlining. Delay genericizing nested functions - until their parent function is genericized. Since finalizing - requires GENERIC, delay that as well. */ - - // This is the comment in gcc/c/c-decl.c: - - /* Register this function with cgraph just far enough to get it - added to our parent's nested function list. Handy, since the - C front end doesn't have such a list. */ - - static cgraph_node *node = cgraph_node::get_create (current_function->function_decl); - gcc_assert(node); - - } - else - { - // This makes the function visible on the source code module level. - cgraph_node::finalize_function (current_function->function_decl, true); - } + /* Because COBOL functions can be misleadingly referenced before they + defined, and because our compiler is single pass, we need to defer + actually passing the function_decls to the middle end until we are + done with the entire compilation unit. + + An actual example: + + IDENTIFICATION DIVISION. + PROGRAM-ID. A. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CWD PIC X(100). + 01 LEN_OF_CWD PIC 999 VALUE 100. + PROCEDURE DIVISION. + CALL "getcwd" USING BY REFERENCE CWD BY VALUE LEN_OF_CWD + DISPLAY CWD + goback. + END PROGRAM A. + IDENTIFICATION DIVISION. + PROGRAM-ID. B. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CWD PIC X(100). + 01 RETURNED-CWD PIC X(100). + 01 LEN_OF_CWD PIC 999 VALUE 100. + PROCEDURE DIVISION. + CALL "getcwd" USING BY REFERENCE CWD BY VALUE LEN_OF_CWD RETURNING RETURNED-CWD + DISPLAY RETURNED-CWD + goback. + END PROGRAM B. + + When we encounter the first call to getcwd, we have no clue as to the + type of the return value, so we assume it is COBOL_FUNCTION_RETURN_TYPE + + When we encounter the second call, we learn that it returns CHAR_P. But + an attempt to change the return type of the function_decl will result + in problems if the function_decl of A is processed by the middle end + before we get a chance to change the getcwd functiona_decl. + + Hence the need for finalized_function_decls, which gets processed + at the end of the file. */ + + finalized_function_decls.push_back(current_function->function_decl); dump_function (TDI_original, current_function->function_decl); if( gg_trans_unit.function_stack.back().context_count ) { - cbl_internal_error("Residual context count!"); + cbl_internal_error("Residual context count"); } gg_trans_unit.function_stack.pop_back(); } void +gg_leaving_the_source_code_file() + { + for( std::vector<tree>::const_iterator it=finalized_function_decls.begin(); + it != finalized_function_decls.end(); + it++ ) + { + //This makes the function visible on the source code module level. + cgraph_node::finalize_function(*it, true); + } + } + +void gg_push_context() { // Sit back, relax, prepare to be amazed. @@ -3084,8 +3052,7 @@ gg_call_expr(tree return_type, const char *function_name, ...) { if(nargs >= ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### You *must* be joking!"); + yywarn("You *must* be joking"); gcc_unreachable(); } @@ -3141,8 +3108,7 @@ gg_call(tree return_type, const char *function_name, ...) { if(nargs >= ARG_LIMIT) { - yywarn("###### %10s in %s:%d", __func__, __FILE__,__LINE__ ); - yywarn("###### You *must* be joking!"); + yywarn("You *must* be joking"); gcc_unreachable(); } @@ -3179,7 +3145,7 @@ gg_call(tree return_type, const char *function_name, ...) } tree -gg_call_expr_list(tree return_type, tree function_name, int param_count, tree args[]) +gg_call_expr_list(tree return_type, tree function_pointer, int param_count, tree args[]) { // Generalized caller. param_count is the count of params in the arg[]] @@ -3196,7 +3162,7 @@ gg_call_expr_list(tree return_type, tree function_name, int param_count, tree ar tree the_call = build_call_array_loc(location_from_lineno(), return_type, - function_name, + function_pointer, param_count, args); // This routine returns the call_expr; the caller will have to deal with it @@ -3438,8 +3404,31 @@ gg_trans_unit_var_decl(const char *var_name) return NULL_TREE; } +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wsuggest-attribute=format" + void -gg_insert_into_assembler(const char *format, ...) +gg_insert_into_assembler(const char ach[]) + { + if( !optimize ) + { + // Create the required generic tag + tree asm_expr = build5_loc( location_from_lineno(), + ASM_EXPR, + VOID, + build_string(strlen(ach), ach), + NULL_TREE, + NULL_TREE, + NULL_TREE, + NULL_TREE); + + // And insert it as a statement + gg_append_statement(asm_expr); + } + } + +void +gg_insert_into_assemblerf(const char *format, ...) { // Temporarily defeat all ASM_EXPR for optimized code per PR119214 // The correct solution using LABEL_DECL is forthcoming @@ -3458,18 +3447,8 @@ gg_insert_into_assembler(const char *format, ...) vsnprintf(ach, sizeof(ach), format, ap); va_end(ap); - // Create the required generic tag - tree asm_expr = build5_loc( location_from_lineno(), - ASM_EXPR, - VOID, - build_string(strlen(ach), ach), - NULL_TREE, - NULL_TREE, - NULL_TREE, - NULL_TREE); - //SET_EXPR_LOCATION (asm_expr, UNKNOWN_LOCATION); - - // And insert it as a statement - gg_append_statement(asm_expr); + gg_insert_into_assembler(ach); } } + +#pragma GCC diagnostic pop
\ No newline at end of file |