diff options
Diffstat (limited to 'gcc/cobol/genapi.cc')
| -rw-r--r-- | gcc/cobol/genapi.cc | 115 |
1 files changed, 41 insertions, 74 deletions
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index fbe0bbc..c8911f9 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -34,6 +34,7 @@ #include "tree-iterator.h" #include "stringpool.h" #include "diagnostic-core.h" +#include "target.h" #include "../../libgcobol/ec.h" #include "../../libgcobol/common-defs.h" @@ -75,7 +76,7 @@ static int pseudo_label = 1; static bool suppress_cobol_entry_point = false; static char ach_cobol_entry_point[256] = ""; -bool bSHOW_PARSE = getenv("SHOW_PARSE"); +bool bSHOW_PARSE = getenv("GCOBOL_SHOW"); bool show_parse_sol = true; int show_parse_indent = 0; @@ -198,7 +199,7 @@ trace1_init() trace_handle = gg_define_variable(INT, "trace_handle", vs_static); trace_indent = gg_define_variable(INT, "trace_indent", vs_static); - bTRACE1 = getenv("TRACE1") ? getenv("TRACE1") : gv_trace_switch; + bTRACE1 = getenv("GCOBOL_TRACE") ? getenv("GCOBOL_TRACE") : gv_trace_switch; if( bTRACE1 && strcmp(bTRACE1, "0") != 0 ) { @@ -787,13 +788,13 @@ function_handle_from_name(cbl_refer_t &name, { gg_memcpy(gg_get_address_of(function_handle), member(name.field->var_decl_node, "data"), - build_int_cst_type(SIZE_T, sizeof(void *))); + sizeof_pointer); } else { gg_memcpy(gg_get_address_of(function_handle), qualified_data_source(name), - build_int_cst_type(SIZE_T, sizeof(void *))); + sizeof_pointer); } return function_handle; } @@ -2028,10 +2029,12 @@ cobol_compare( tree return_int, { // None of our explicit comparisons up above worked, so we revert to the // general case: - int leftflags = (left_side_ref.all ? REFER_T_MOVE_ALL : 0) - + (left_side_ref.addr_of ? REFER_T_ADDRESS_OF : 0); - int rightflags = (right_side_ref.all ? REFER_T_MOVE_ALL : 0) - + (right_side_ref.addr_of ? REFER_T_ADDRESS_OF : 0); + int leftflags = (left_side_ref.all ? REFER_T_MOVE_ALL : 0) + + (left_side_ref.addr_of ? REFER_T_ADDRESS_OF : 0) + + (left_side_ref.refmod.from ? REFER_T_REFMOD : 0); + int rightflags = (right_side_ref.all ? REFER_T_MOVE_ALL : 0) + + (right_side_ref.addr_of ? REFER_T_ADDRESS_OF : 0) + + (right_side_ref.refmod.from ? REFER_T_REFMOD : 0); gg_assign( return_int, gg_call_expr( INT, "__gg__compare", @@ -2045,6 +2048,7 @@ cobol_compare( tree return_int, build_int_cst_type(INT, rightflags), integer_zero_node, NULL_TREE)); + compared = true; } // gg_printf(" result is %d\n", return_int, NULL_TREE); @@ -2354,7 +2358,8 @@ section_label(struct cbl_proc_t *procedure) cbl_label_t *label = procedure->label; // The _initialize_program section isn't relevant. - char *psz = xasprintf("# SECTION %s in %s (%ld)", + char *psz = xasprintf("%s SECTION %s in %s (%ld)", + ASM_COMMENT_START, label->name, current_function->our_unmangled_name, deconflictor); @@ -2405,7 +2410,8 @@ paragraph_label(struct cbl_proc_t *procedure) char *psz1 = xasprintf( - "# PARAGRAPH %s of %s in %s (%ld)", + "%s PARAGRAPH %s of %s in %s (%ld)", + ASM_COMMENT_START, para_name ? para_name: "" , section_name ? section_name: "(null)" , current_function->our_unmangled_name ? current_function->our_unmangled_name: "" , @@ -3003,7 +3009,8 @@ parser_perform(cbl_label_t *label, bool suppress_nexting) para_name = label->name; sect_name = section_label->name; sprintf(ach, - "# PERFORM %s of %s of %s (%ld)", + "%s PERFORM %s of %s of %s (%ld)", + ASM_COMMENT_START, para_name, sect_name, program_name, @@ -3015,7 +3022,8 @@ parser_perform(cbl_label_t *label, bool suppress_nexting) { sect_name = label->name; sprintf(ach, - "# PERFORM %s of %s (%ld)", + "%s PERFORM %s of %s (%ld)", + ASM_COMMENT_START, sect_name, program_name, deconflictor); @@ -3167,8 +3175,8 @@ internal_perform_through( cbl_label_t *proc_1, pseudo_return_push(proc2, return_addr); // Create the code that will launch the first procedure - gg_insert_into_assembler("# PERFORM %s THROUGH %s", - proc_1->name, proc_2->name); + gg_insert_into_assembler("%s PERFORM %s THROUGH %s", + ASM_COMMENT_START, proc_1->name, proc_2->name); if( !suppress_nexting ) { @@ -6629,22 +6637,6 @@ parser_division(cbl_division_t division, } gg_assign(base, gg_cast(UCHAR_P, parameter)); - IF( gg_call_expr( CHAR_P, - "getenv", - gg_string_literal("PARAMETERS_ON_ENTRY"), - NULL_TREE), - ne_op, - gg_cast(CHAR_P, null_pointer_node)); - { - gg_printf("parameter_on_entry: %s(): %d %p\n", - gg_string_literal(current_function->our_unmangled_name), - build_int_cst_type(INT, i+1), - base, - NULL_TREE); - } - ELSE - ENDIF - if( args[i].refer.field->attr & any_length_e ) { // gg_printf("side channel: Length of \"%s\" is %ld\n", @@ -8917,8 +8909,8 @@ parser_file_add(struct cbl_file_t *file) gg_assign(array_of_keys, gg_cast(build_pointer_type(cblc_field_p_type_node), gg_malloc(build_int_cst_type(SIZE_T, - (number_of_key_fields+1) - *sizeof(void *))))); + (number_of_key_fields+1) + *int_size_in_bytes(VOID_P))))); strcpy(achName, "_"); strcat(achName, file->name); @@ -8929,8 +8921,8 @@ parser_file_add(struct cbl_file_t *file) gg_assign(key_numbers, gg_cast(build_pointer_type(INT), gg_malloc(build_int_cst_type(SIZE_T, - (number_of_key_fields+1) - *sizeof(int))))); + (number_of_key_fields+1) + *int_size_in_bytes(INT))))); strcpy(achName, "_"); strcat(achName, file->name); @@ -8942,7 +8934,7 @@ parser_file_add(struct cbl_file_t *file) gg_cast(build_pointer_type(INT), gg_malloc(build_int_cst_type(SIZE_T, (number_of_key_fields+1) - *sizeof(int))))); + *int_size_in_bytes(INT))))); size_t index = 0; for( size_t i=0; i<file->nkey; i++ ) @@ -9686,7 +9678,9 @@ inspect_tally(bool backward, gg_assign(int_size, build_int_cst_type(INT, n_integers)); gg_assign(integers, gg_cast(SIZE_T_P, - gg_realloc(integers, n_integers * sizeof(void *)))); + gg_realloc(integers, + n_integers + * int_size_in_bytes(VOID_P)))); } ELSE { @@ -9837,7 +9831,9 @@ inspect_replacing(int backward, gg_assign(int_size, build_int_cst_type(INT, n_integers)); gg_assign(integers, gg_cast(SIZE_T_P, - gg_realloc(integers, n_integers * sizeof(void *)))); + gg_realloc(integers, + n_integers + * int_size_in_bytes(VOID_P)))); } ELSE { @@ -11074,7 +11070,9 @@ gg_array_of_field_pointers( size_t N, cbl_field_t **fields ) { tree retval = gg_define_variable(build_pointer_type(cblc_field_p_type_node)); - gg_assign(retval, gg_cast(build_pointer_type(cblc_field_p_type_node), gg_malloc( build_int_cst_type(SIZE_T, N * sizeof(void *))))); + gg_assign(retval, gg_cast(build_pointer_type(cblc_field_p_type_node), + gg_malloc(build_int_cst_type(SIZE_T, + N * int_size_in_bytes(VOID_P))))); for(size_t i=0; i<N; i++) { gg_assign(gg_array_value(retval, i), gg_get_address_of(fields[i]->var_decl_node)); @@ -11566,7 +11564,8 @@ gg_array_of_file_pointers( size_t N, { tree retval = gg_define_variable(build_pointer_type(cblc_file_p_type_node)); gg_assign(retval, gg_cast( build_pointer_type(cblc_file_p_type_node), - gg_malloc( build_int_cst_type(SIZE_T, N * sizeof(void *))))); + gg_malloc( build_int_cst_type(SIZE_T, + N * int_size_in_bytes(VOID_P))))); for(size_t i=0; i<N; i++) { gg_assign(gg_array_value(retval, i), gg_get_address_of(files[i]->var_decl_node)); @@ -12853,7 +12852,7 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source ) COBOL_FUNCTION_RETURN_TYPE); gg_memcpy(qualified_data_dest(tgts[i]), gg_get_address_of(function_handle), - build_int_cst_type(SIZE_T, sizeof(void *))); + sizeof_pointer); } else { @@ -13612,7 +13611,7 @@ hijack_for_development(const char *funcname) // Assume that funcname is lowercase with no hyphens enter_program_common(funcname, funcname); parser_display_literal("You have been hijacked by a program named \"dubner\""); - gg_insert_into_assembler("# HIJACKED DUBNER CODE START"); + gg_insert_into_assembler("%s HIJACKED DUBNER CODE START", ASM_COMMENT_START); for(int i=0; i<10; i++) { @@ -13625,7 +13624,7 @@ hijack_for_development(const char *funcname) NULL_TREE); } - gg_insert_into_assembler("# HIJACKED DUBNER CODE END"); + gg_insert_into_assembler("%s HIJACKED DUBNER CODE END", ASM_COMMENT_START); gg_return(0); } @@ -15861,38 +15860,6 @@ psa_global(cbl_field_t *new_var) sprintf(ach, "__gg__%s", mname); free(mname); - if( getenv("SHOW_GLOBAL_VARIABLES") ) - { - char ach_type[32]; - strcpy(ach_type, cbl_field_type_str(new_var->type)); - - fprintf(stderr, "struct cblc_field_t %s = {\n", ach); - fprintf(stderr, " .data = NULL ,\n" ); - fprintf(stderr, " .capacity = %d ,\n", new_var->data.capacity ); - fprintf(stderr, " .offset = %ld ,\n" , new_var->offset ); - fprintf(stderr, " .name = \"%s\" ,\n" , new_var->name ); - fprintf(stderr, " .picture = \"%s\" ,\n" , new_var->data.picture ? new_var->data.picture : "" ); - if( new_var->data.initial || new_var->type == FldPointer ) - { - fprintf(stderr, " .initial = \"%s\" ,\n" , new_var->data.picture ? new_var->data.picture : "" ); - } - else - { - fprintf(stderr, " .initial = NULL ,\n" ); - } - fprintf(stderr, " .parent = NULL,\n" ); - fprintf(stderr, " .depending_on = NULL ,\n" ); - fprintf(stderr, " .depends_on = NULL ,\n" ); - fprintf(stderr, " .occurs_lower = 0 ,\n" ); - fprintf(stderr, " .occurs_upper = 0 ,\n" ); - fprintf(stderr, " .attr = 0x%lx ,\n" , new_var->attr ); - fprintf(stderr, " .type = %s ,\n" , ach_type); - fprintf(stderr, " .level = %d ,\n" , new_var->level ); - fprintf(stderr, " .digits = %d ,\n" , new_var->data.digits ); - fprintf(stderr, " .rdigits = %d ,\n" , new_var->data.rdigits ); - fprintf(stderr, " };\n"); - } - if( strcmp(new_var->name, "_VERY_TRUE") == 0 ) { new_var->var_decl_node = boolean_true_node; |