diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 0a3cba03546e8bbfb99315b3aab8d464ae61141c..7967f894c290712791a3fb16ed7f46688238dbbc 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -3233,7 +3233,8 @@ enter_program_common(const char *funcname, const char *funcname_) } void -parser_enter_program(const char *funcname_) +parser_enter_program( const char *funcname_, + bool is_function) // True for user-defined-function { // The first thing we have to do is mangle this name. This is safe even // though the end result will be mangled again, because the mangler doesn't @@ -3262,18 +3263,21 @@ parser_enter_program(const char *funcname_) SHOW_PARSE_END } - if( next_program_is_main ) + if( !is_function ) { - next_program_is_main = false; - if(main_entry_point) + if( next_program_is_main ) { - build_main_that_calls_something(main_entry_point); - free(main_entry_point); - main_entry_point = NULL; - } - else - { - build_main_that_calls_something(funcname); + next_program_is_main = false; + if(main_entry_point) + { + build_main_that_calls_something(main_entry_point); + free(main_entry_point); + main_entry_point = NULL; + } + else + { + build_main_that_calls_something(funcname); + } } } @@ -5462,9 +5466,6 @@ parser_division(cbl_division_t division, gg_get_address_of(data_decl_node) ); // And then move it into place - gg_printf("About to get BY VALUE and put it into %p\n", - member(new_var->var_decl_node, "data"), - NULL_TREE); gg_call(VOID, "__gg__assign_value_from_stack", 2, diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index ea37e6bf0200f6470879716d6c7fc858b30539d1..cac09aa5ab3f7c57d893747735901e4b9a317634 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -52,7 +52,7 @@ void parser_next_is_main(bool is_main); void parser_internal_is_ebcdic(bool is_ebcdic); void parser_division( cbl_division_t division, cbl_field_t *ret, size_t narg, cbl_ffi_arg_t args[] ); -void parser_enter_program(const char *funcname); +void parser_enter_program(const char *funcname, bool is_function); void parser_leave_program(); void parser_accept( struct cbl_refer_t refer, enum special_name_t special_e); diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index a49d047c442eaf704b0012d866e2f3c2b317f9be..4c142c3362c470e01db535fabff4206f0bef79a3 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -946,7 +946,7 @@ program_id: PROGRAM_ID dot namestr[name] program_as program_attrs[attr] dot current_division = identification_div_e; parser_division( identification_div_e, NULL, 0, NULL ); location_set(@1); - parser_enter_program( name ); + parser_enter_program( name, false ); if( symbols_begin() == symbols_end() ) { symbol_table_init(); } @@ -969,7 +969,7 @@ function_id: FUNCTION '.' NAME program_as program_attrs[attr] '.' current_division = identification_div_e; parser_division( identification_div_e, NULL, 0, NULL ); statement_begin(@1, FUNCTION); - parser_enter_program( $NAME ); + parser_enter_program( $NAME, true ); if( symbols_begin() == symbols_end() ) { symbol_table_init(); } @@ -3021,10 +3021,13 @@ data_descr1: level_name if( ! ($field->data.capacity + 1 == strlen($field->data.initial) && p[-1] == '!') ) { char *msg; - asprintf(&msg, "warning: VALUE of %s " + if(asprintf(&msg, "warning: VALUE of %s " "has length %zu, exceeding its size (%u)", $field->name, strlen($field->data.initial), - $field->data.capacity); + $field->data.capacity) == -1) { + warnx("Some kind of error in asprintf() %s %d", __func__, __LINE__); + } + yywarn(msg); } } diff --git a/gcc/cobol/parse_util.h b/gcc/cobol/parse_util.h index af767347680e3a73f2a29eef4c3b54f6546cc737..59093ed807a1e4890af8a07e44d30886968b86c2 100644 --- a/gcc/cobol/parse_util.h +++ b/gcc/cobol/parse_util.h @@ -245,6 +245,7 @@ static const intrinsic_args_t *eoargs = intrinsic_args + COUNT_OF(intrinsic_args); static const char intrinsic_unimplemented[][40] = { + "argle-bargle", // gives ::find something to chew on // "__gg__bit_of", // "__gg__bit_to_char", // "__gg__display_of", diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index 98f466625f9507ada3579a831fa5f529f18eb6d3..c4098e8b426c725c707cc35673f21a889fbaa236 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -8174,8 +8174,11 @@ __gg__assign_value_from_stack(cblc_field_t *dest, size_t parameter) case FldGroup: case FldAlphanumeric: case FldAlphaEdited: + case FldNumericEdited: if( dest->capacity >= 1) { + warnx("%s is not valid for BY VALUE", dest->name); + exit(1); memset(dest->data, internal_space, dest->capacity); // A single 8-bit character was placed in the 64-bit entry on the // stack. @@ -8206,7 +8209,6 @@ __gg__assign_value_from_stack(cblc_field_t *dest, size_t parameter) case FldPacked: case FldNumericBin5: case FldNumericDisplay: - case FldNumericEdited: case FldLiteralN: case FldIndex: case FldPointer: