From: Robert Dubner Date: Thu, 12 Feb 2026 16:11:51 +0000 (-0500) Subject: cobol: Repair CALL ... USING BY VALUE. X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e0bbad05caa63910c012adc64f73d375e1d2a3ca;p=thirdparty%2Fgcc.git cobol: Repair CALL ... USING BY VALUE. These changes cause CALL ... USING BY VALUE to work properly for a wider range of COBOL variables types, values, and sizes. Some sizes of numeric-display variables didn't work, some didn't work for negative values, and floating-extended didn't work at all. Now they do. Fourteen new DejaGnu tests cover this repaired capability. gcc/cobol/ChangeLog: * genapi.cc (establish_using): Use a 128-bit type for float-extended; handle numeric-edited values of different sizes and signs correctly. (create_and_call): Use a 128-bit type for float-extended. libgcobol/ChangeLog: * Makefile.am: Temporarily continue to use -fno-strict-aliasing. * Makefile.in: Likewise. * libgcobol.cc (__gg__fetch_call_by_value_value): Simplify handling of FldFloat. (__gg__assign_value_from_stack): Likewise. (__gg__unstring): Avoid uninitialized variable error. (__gg__look_at_int128): New function useful for debugging. (__gg__look_at_pointer): Likewise. * xmlparse.cc (xml_event): Implement namespace XML. (cdataBlock): Likewise. (characters): Likewise. (__gg__xml_parse): Likewise. gcc/testsuite/ChangeLog: * cobol.dg/group2/USING_COMP-3_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_COMP-3_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_COMP-3_BY_VALUE.cob: New test. * cobol.dg/group2/USING_COMP-3_BY_VALUE.out: New test. * cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.cob: New test. * cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.out: New test. * cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_NumericDisplay_BY_VALUE.cob: New test. * cobol.dg/group2/USING_NumericDisplay_BY_VALUE.out: New test. * cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.cob: New test. * cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.out: New test. * cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.cob: New test. * cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.out: New test. * cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.cob: New test. * cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.out: New test. * cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.cob: New test. * cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.out: New test. * cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.cob: New test. * cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.out: New test. --- diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 40be939dd72..108fb7f38f4 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -7012,7 +7012,14 @@ establish_using(size_t nusing, tree par_type = tree_type_from_field_type(args[i].refer.field, nbytes); if( par_type == FLOAT ) { - par_type = SSIZE_T; + if( nbytes == 16 ) + { + par_type = INT128; + } + else + { + par_type = SSIZE_T; + } } if( par_type == DOUBLE ) { @@ -7087,56 +7094,6 @@ establish_using(size_t nusing, // It makes more sense if you don't think about it too hard. - // We need to be able to restore prior arguments when doing recursive - // calls: - IF( member(args[i].refer.field->var_decl_node, "data"), - ne_op, - gg_cast(UCHAR_P, null_pointer_node) ) - { - gg_call(VOID, - "__gg__push_local_variable", - gg_get_address_of(args[i].refer.field->var_decl_node), - NULL_TREE); - } - ELSE - ENDIF - - tree base = gg_define_variable(UCHAR_P); - gg_assign(rt_i, build_int_cst_type(INT, i)); - //gg_printf("The rt_i counter is %d\n", rt_i, NULL_TREE); - IF( rt_i, lt_op , var_decl_call_parameter_count ) - { - if( i == 0 ) - { - // This is the first parameter. - parameter = DECL_ARGUMENTS(current_function->function_decl); - } - else - { - // These are subsequent parameters - parameter = TREE_CHAIN(parameter); - } - gg_assign(base, gg_cast(UCHAR_P, parameter)); - - if( args[i].refer.field->attr & any_length_e ) - { - // gg_printf("side channel: Length of \"%s\" is %ld\n", - // member(args[i].refer.field->var_decl_node, "name"), - // gg_array_value(var_decl_call_parameter_lengths, rt_i), - // NULL_TREE); - - // Get the length from the global lengths[] side channel. Don't - // forget to use the length mask on the table value. - gg_assign(member(args[i].refer.field->var_decl_node, "capacity"), - gg_array_value(var_decl_call_parameter_lengths, rt_i)); - } - } - ELSE - { - gg_assign(base, gg_cast(UCHAR_P, null_pointer_node)); - } - ENDIF - // Arriving here means that we are processing an instruction like // this: // PROCEDURE DIVISION USING using[0] using[1] ... using using[nusing-1] @@ -7145,6 +7102,7 @@ establish_using(size_t nusing, // an OTHER-TO-COBOL call and the var_decl_call_parameter_lengths array // is not valid + // Sort out the USING BY; it can be BY REFERENCE or BY VALUE: cbl_ffi_crv_t crv = args[i].crv; cbl_field_t *new_var = args[i].refer.field; @@ -7163,46 +7121,158 @@ establish_using(size_t nusing, } } - if( crv == by_value_e ) + // We need to be able to restore prior arguments when doing recursive + // calls: + IF( member(args[i].refer.field->var_decl_node, "data"), + ne_op, + gg_cast(UCHAR_P, null_pointer_node) ) { - // 'parameter' is the 64-bit or 128-bit value that was placed on the stack + gg_call(VOID, + "__gg__push_local_variable", + gg_get_address_of(args[i].refer.field->var_decl_node), + NULL_TREE); + } + ELSE + ENDIF + + if( crv == by_reference_e ) + { + // The passed parameter, if it exists, is a pointer to a COBOL + // variable's data area + tree reference = gg_define_variable(UCHAR_P); + gg_assign(rt_i, build_int_cst_type(INT, i)); + IF( rt_i, lt_op , var_decl_call_parameter_count ) + { + if( i == 0 ) + { + // This is the first parameter. + parameter = DECL_ARGUMENTS(current_function->function_decl); + } + else + { + // These are subsequent parameters + parameter = TREE_CHAIN(parameter); + } + gg_assign(reference, gg_cast(UCHAR_P, parameter)); + + if( args[i].refer.field->attr & any_length_e ) + { + // gg_printf("side channel: Length of \"%s\" is %ld\n", + // member(args[i].refer.field->var_decl_node, "name"), + // gg_array_value(var_decl_call_parameter_lengths, rt_i), + // NULL_TREE); + + // Get the length from the global lengths[] side channel. Don't + // forget to use the length mask on the table value. + gg_assign(member(args[i].refer.field->var_decl_node, "capacity"), + gg_array_value(var_decl_call_parameter_lengths, rt_i)); + } + } + ELSE + { + gg_assign(reference, gg_cast(UCHAR_P, null_pointer_node)); + } + ENDIF + // 'parameter' is a reference, so it it becomes the data member of + // the cblc_field_t COBOL variable. + gg_assign(member(args[i].field()->var_decl_node, "data"), reference); + // We need to apply reference + offset to the LINKAGE variable + // and all of its children + propogate_linkage_offsets( args[i].field(), reference ); + } + + if( crv == by_value_e ) + { size_t nbytes; tree_type_from_field_type(new_var, nbytes); tree parm = gg_define_variable(INT128); + tree value_type; + if( nbytes == 16 ) + { + value_type = INT128; + } + else + { + value_type = SSIZE_T; + } + + // 'parameter' is the 64-bit or 128-bit value that was placed on the stack + tree value = gg_define_variable(value_type); + + gg_assign(rt_i, build_int_cst_type(INT, i)); + IF( rt_i, lt_op , var_decl_call_parameter_count ) + { + if( i == 0 ) + { + // This is the first parameter. + parameter = DECL_ARGUMENTS(current_function->function_decl); + } + else + { + // These are subsequent parameters + parameter = TREE_CHAIN(parameter); + } + gg_assign(value, gg_cast(value_type, parameter)); + gg_memcpy(gg_get_address_of(value), + gg_get_address_of(parameter), + build_int_cst_type(SIZE_T, nbytes)); + + if( args[i].refer.field->attr & any_length_e ) + { + // gg_printf("side channel: Length of \"%s\" is %ld\n", + // member(args[i].refer.field->var_decl_node, "name"), + // gg_array_value(var_decl_call_parameter_lengths, rt_i), + // NULL_TREE); + + // Get the length from the global lengths[] side channel. Don't + // forget to use the length mask on the table value. + gg_assign(member(args[i].refer.field->var_decl_node, "capacity"), + gg_array_value(var_decl_call_parameter_lengths, rt_i)); + } + } + ELSE + { + gg_assign(value, gg_cast(value_type, integer_zero_node)); + } + ENDIF + if( nbytes <= 8 ) { // Our input is a 64-bit number if( new_var->attr & signable_e ) { - IF( gg_bitwise_and( gg_cast(SIZE_T, base), + IF( gg_bitwise_and( gg_cast(SIZE_T, value), build_int_cst_type(SIZE_T, 0x8000000000000000ULL)), ne_op, gg_cast(SIZE_T, integer_zero_node) ) { - // Our input is a negative number + // Our input is a negative number. Set it to -1, so that the + // eight high-order bytes are 0xFF gg_assign(parm, gg_cast(INT128, integer_minus_one_node)); } ELSE { - // Our input is a positive number + // Our input is a positive number, so set it to zero, so that + // the eight high-order bytes are 0x00 gg_assign(parm, gg_cast(INT128, integer_zero_node)); } ENDIF } else { - // This is a 64-bit positive number: + // This is a 64-bit positive number: so set it to zero, so that + // the eight high-order bytes are 0x00 gg_assign(parm, gg_cast(INT128, integer_zero_node)); } } - // At this point, parm has been set to 0 or -1 + // Now copy over the little-endian binary bytes, either 8 or 16 as + // necessary gg_memcpy(gg_get_address_of(parm), - gg_get_address_of(base), + gg_get_address_of(value), build_int_cst_type(SIZE_T, nbytes)); - tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity()); tree data_decl_node = gg_define_variable( array_type, NULL, @@ -7253,16 +7323,6 @@ establish_using(size_t nusing, next_index += 1; } } - else - { - // 'parameter' is a reference, so it it becomes the data member of - // the cblc_field_t COBOL variable. - gg_assign(member(args[i].field()->var_decl_node, "data"), base); - - // We need to apply base + offset to the LINKAGE variable - // and all of its children - propogate_linkage_offsets( args[i].field(), base ); - } } } } @@ -13297,8 +13357,7 @@ create_and_call(size_t narg, if( !(args[i].refer.field->attr & intermediate_e) ) { // All temporaries are SIZE_T - if( args[i].refer.field->type == FldFloat - && args[i].refer.field->data.capacity() == 16 ) + if( args[i].refer.field->type == FldFloat ) { as_int128 = true; } diff --git a/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.cob new file mode 100644 index 00000000000..351cafafeb9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_COMP-3_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic 9(2) comp-3. + 01 var16 pic 9(4) comp-3. + 01 var32 pic 9(8) comp-3. + 01 var64 pic 9(16) comp-3. + 01 var128 pic 9(32) comp-3. + 01 var8r pic 9(2) comp-3. + 01 var16r pic 9(4) comp-3. + 01 var32r pic 9(8) comp-3. + 01 var64r pic 9(16) comp-3. + 01 var128r pic 9(32) comp-3. + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) comp-3 . + 01 varr pic 9(2) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) comp-3 . + 01 varr pic 9(4) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) comp-3 . + 01 varr pic 9(8) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) comp-3 . + 01 varr pic 9(16) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) comp-3 . + 01 varr pic 9(32) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.out new file mode 100644 index 00000000000..acf2c031d79 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_REFERENCE.out @@ -0,0 +1,11 @@ +12 +12 +1234 +1234 +12345678 +12345678 +1234567890123456 +1234567890123456 +12345678901234567890123456789012 +12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.cob new file mode 100644 index 00000000000..65d787407f8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_COMP-3_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic 9(2) comp-3. + 01 var16 pic 9(4) comp-3. + 01 var32 pic 9(8) comp-3. + 01 var64 pic 9(16) comp-3. + 01 var128 pic 9(32) comp-3. + 01 var8r pic 9(2) comp-3. + 01 var16r pic 9(4) comp-3. + 01 var32r pic 9(8) comp-3. + 01 var64r pic 9(16) comp-3. + 01 var128r pic 9(32) comp-3. + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) comp-3 . + 01 varr pic 9(2) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) comp-3 . + 01 varr pic 9(4) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) comp-3 . + 01 varr pic 9(8) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) comp-3 . + 01 varr pic 9(16) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) comp-3 . + 01 varr pic 9(32) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.out new file mode 100644 index 00000000000..acf2c031d79 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_COMP-3_BY_VALUE.out @@ -0,0 +1,11 @@ +12 +12 +1234 +1234 +12345678 +12345678 +1234567890123456 +1234567890123456 +12345678901234567890123456789012 +12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.cob new file mode 100644 index 00000000000..e11f0db7e9d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.cob @@ -0,0 +1,58 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_FLOAT-SLX_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var1 float-short . + 01 var2 float-long . + 01 var3 float-extended . + 01 var1r float-short . + 01 var2r float-long . + 01 var3r float-extended . + procedure division. + move 1.234E30 to var1 + move 2.345E300 to var2 + move 3.456E4000 to var3 + display var1 + call "rvar1" using by reference var1 returning var1r + display var1r + display var2 + call "rvar2" using by reference var2 returning var2r + display var2r + display var3 + call "rvar3" using by reference var3 returning var3r + display var3r + goback. + end program prog. + + identification division. + program-id. rvar1. + data division. + linkage section. + 01 var float-short. + 01 varr float-short. + procedure division using by reference var returning varr. + move var to varr. + end program rvar1. + + identification division. + program-id. rvar2. + data division. + linkage section. + 01 var float-long. + 01 varr float-long. + procedure division using by reference var returning varr. + move var to varr. + end program rvar2. + + identification division. + program-id. rvar3. + data division. + linkage section. + 01 var float-extended. + 01 varr float-extended. + procedure division using by reference var returning varr. + move var to varr. + end program rvar3. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.out new file mode 100644 index 00000000000..bc5dd62ddee --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_REFERENCE.out @@ -0,0 +1,7 @@ +1.233999999E+30 +1.233999999E+30 +2.34500000000000002E+300 +2.34500000000000002E+300 +3.455999999999999999999999999999999993E+4000 +3.455999999999999999999999999999999993E+4000 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.cob new file mode 100644 index 00000000000..f2cdeca5102 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.cob @@ -0,0 +1,58 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_FLOAT-SLX_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var1 float-short . + 01 var2 float-long . + 01 var3 float-extended . + 01 var1r float-short . + 01 var2r float-long . + 01 var3r float-extended . + procedure division. + move 1.234E30 to var1 + move 2.345E300 to var2 + move 3.456E4000 to var3 + display var1 + call "rvar1" using by value var1 returning var1r + display var1r + display var2 + call "rvar2" using by value var2 returning var2r + display var2r + display var3 + call "rvar3" using by value var3 returning var3r + display var3r + goback. + end program prog. + + identification division. + program-id. rvar1. + data division. + linkage section. + 01 var float-short. + 01 varr float-short. + procedure division using by value var returning varr. + move var to varr. + end program rvar1. + + identification division. + program-id. rvar2. + data division. + linkage section. + 01 var float-long. + 01 varr float-long. + procedure division using by value var returning varr. + move var to varr. + end program rvar2. + + identification division. + program-id. rvar3. + data division. + linkage section. + 01 var float-extended. + 01 varr float-extended. + procedure division using by value var returning varr. + move var to varr. + end program rvar3. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.out new file mode 100644 index 00000000000..bc5dd62ddee --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_FLOAT-SLX_BY_VALUE.out @@ -0,0 +1,7 @@ +1.233999999E+30 +1.233999999E+30 +2.34500000000000002E+300 +2.34500000000000002E+300 +3.455999999999999999999999999999999993E+4000 +3.455999999999999999999999999999999993E+4000 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.cob new file mode 100644 index 00000000000..544d65aaba8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_NumericDisplay_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic 9(2). + 01 var16 pic 9(4). + 01 var32 pic 9(8). + 01 var64 pic 9(16). + 01 var128 pic 9(32). + 01 var8r pic 9(2). + 01 var16r pic 9(4). + 01 var32r pic 9(8). + 01 var64r pic 9(16). + 01 var128r pic 9(32). + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) . + 01 varr pic 9(2) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) . + 01 varr pic 9(4) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) . + 01 varr pic 9(8) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) . + 01 varr pic 9(16) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) . + 01 varr pic 9(32) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.out new file mode 100644 index 00000000000..acf2c031d79 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_REFERENCE.out @@ -0,0 +1,11 @@ +12 +12 +1234 +1234 +12345678 +12345678 +1234567890123456 +1234567890123456 +12345678901234567890123456789012 +12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.cob new file mode 100644 index 00000000000..c120cc9a5bf --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_NumericDisplay_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic 9(2). + 01 var16 pic 9(4). + 01 var32 pic 9(8). + 01 var64 pic 9(16). + 01 var128 pic 9(32). + 01 var8r pic 9(2). + 01 var16r pic 9(4). + 01 var32r pic 9(8). + 01 var64r pic 9(16). + 01 var128r pic 9(32). + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) . + 01 varr pic 9(2) . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) . + 01 varr pic 9(4) . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) . + 01 varr pic 9(8) . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) . + 01 varr pic 9(16) . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) . + 01 varr pic 9(32) . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.out new file mode 100644 index 00000000000..acf2c031d79 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_NumericDisplay_BY_VALUE.out @@ -0,0 +1,11 @@ +12 +12 +1234 +1234 +12345678 +12345678 +1234567890123456 +1234567890123456 +12345678901234567890123456789012 +12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.cob new file mode 100644 index 00000000000..744ed9205e1 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed_-_COMP-3_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2) comp-3. + 01 var16 pic s9(4) comp-3. + 01 var32 pic s9(8) comp-3. + 01 var64 pic s9(16) comp-3. + 01 var128 pic s9(32) comp-3. + 01 var8r pic s9(2) comp-3. + 01 var16r pic s9(4) comp-3. + 01 var32r pic s9(8) comp-3. + 01 var64r pic s9(16) comp-3. + 01 var128r pic s9(32) comp-3. + procedure division. + move -12 to var8 + move -1234 to var16 + move -12345678 to var32 + move -1234567890123456 to var64 + move -12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic s9(2) comp-3 . + 01 varr pic s9(2) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic s9(4) comp-3 . + 01 varr pic s9(4) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic s9(8) comp-3 . + 01 varr pic s9(8) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic s9(16) comp-3 . + 01 varr pic s9(16) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic s9(32) comp-3 . + 01 varr pic s9(32) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.out new file mode 100644 index 00000000000..12e903f481e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_REFERENCE.out @@ -0,0 +1,11 @@ +-12 +-12 +-1234 +-1234 +-12345678 +-12345678 +-1234567890123456 +-1234567890123456 +-12345678901234567890123456789012 +-12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.cob new file mode 100644 index 00000000000..923376b9618 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed_-_COMP-3_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2) comp-3. + 01 var16 pic s9(4) comp-3. + 01 var32 pic s9(8) comp-3. + 01 var64 pic s9(16) comp-3. + 01 var128 pic s9(32) comp-3. + 01 var8r pic s9(2) comp-3. + 01 var16r pic s9(4) comp-3. + 01 var32r pic s9(8) comp-3. + 01 var64r pic s9(16) comp-3. + 01 var128r pic s9(32) comp-3. + procedure division. + move -12 to var8 + move -1234 to var16 + move -12345678 to var32 + move -1234567890123456 to var64 + move -12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic s9(2) comp-3 . + 01 varr pic s9(2) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic s9(4) comp-3 . + 01 varr pic s9(4) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic s9(8) comp-3 . + 01 varr pic s9(8) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic s9(16) comp-3 . + 01 varr pic s9(16) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic s9(32) comp-3 . + 01 varr pic s9(32) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.out new file mode 100644 index 00000000000..12e903f481e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_COMP-3_BY_VALUE.out @@ -0,0 +1,11 @@ +-12 +-12 +-1234 +-1234 +-12345678 +-12345678 +-1234567890123456 +-1234567890123456 +-12345678901234567890123456789012 +-12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.cob new file mode 100644 index 00000000000..672ad286a60 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2). + 01 var16 pic s9(4). + 01 var32 pic s9(8). + 01 var64 pic s9(16). + 01 var128 pic s9(32). + 01 var8r pic s9(2). + 01 var16r pic s9(4). + 01 var32r pic s9(8). + 01 var64r pic s9(16). + 01 var128r pic s9(32). + procedure division. + move -12 to var8 + move -1234 to var16 + move -12345678 to var32 + move -1234567890123456 to var64 + move -12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic s9(2) . + 01 varr pic s9(2) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic s9(4) . + 01 varr pic s9(4) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic s9(8) . + 01 varr pic s9(8) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic s9(16) . + 01 varr pic s9(16) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic s9(32) . + 01 varr pic s9(32) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.out new file mode 100644 index 00000000000..12e903f481e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_REFERENCE.out @@ -0,0 +1,11 @@ +-12 +-12 +-1234 +-1234 +-12345678 +-12345678 +-1234567890123456 +-1234567890123456 +-12345678901234567890123456789012 +-12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.cob new file mode 100644 index 00000000000..90249304483 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed_-_NumericDisplay_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2). + 01 var16 pic s9(4). + 01 var32 pic s9(8). + 01 var64 pic s9(16). + 01 var128 pic s9(32). + 01 var8r pic s9(2). + 01 var16r pic s9(4). + 01 var32r pic s9(8). + 01 var64r pic s9(16). + 01 var128r pic s9(32). + procedure division. + move -12 to var8 + move -1234 to var16 + move -12345678 to var32 + move -1234567890123456 to var64 + move -12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic s9(2) . + 01 varr pic s9(2) . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic s9(4) . + 01 varr pic s9(4) . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic s9(8) . + 01 varr pic s9(8) . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic s9(16) . + 01 varr pic s9(16) . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic s9(32) . + 01 varr pic s9(32) . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.out new file mode 100644 index 00000000000..12e903f481e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed_-_NumericDisplay_BY_VALUE.out @@ -0,0 +1,11 @@ +-12 +-12 +-1234 +-1234 +-12345678 +-12345678 +-1234567890123456 +-1234567890123456 +-12345678901234567890123456789012 +-12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.cob new file mode 100644 index 00000000000..66bb9675ec5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed___COMP-3_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2) comp-3. + 01 var16 pic s9(4) comp-3. + 01 var32 pic s9(8) comp-3. + 01 var64 pic s9(16) comp-3. + 01 var128 pic s9(32) comp-3. + 01 var8r pic s9(2) comp-3. + 01 var16r pic s9(4) comp-3. + 01 var32r pic s9(8) comp-3. + 01 var64r pic s9(16) comp-3. + 01 var128r pic s9(32) comp-3. + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) comp-3 . + 01 varr pic 9(2) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) comp-3 . + 01 varr pic 9(4) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) comp-3 . + 01 varr pic 9(8) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) comp-3 . + 01 varr pic 9(16) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) comp-3 . + 01 varr pic 9(32) comp-3 . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.out new file mode 100644 index 00000000000..158cda12ec2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_REFERENCE.out @@ -0,0 +1,11 @@ ++12 ++12 ++1234 ++1234 ++12345678 ++12345678 ++1234567890123456 ++1234567890123456 ++12345678901234567890123456789012 ++12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.cob new file mode 100644 index 00000000000..cc7e8e0247b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed___COMP-3_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2) comp-3. + 01 var16 pic s9(4) comp-3. + 01 var32 pic s9(8) comp-3. + 01 var64 pic s9(16) comp-3. + 01 var128 pic s9(32) comp-3. + 01 var8r pic s9(2) comp-3. + 01 var16r pic s9(4) comp-3. + 01 var32r pic s9(8) comp-3. + 01 var64r pic s9(16) comp-3. + 01 var128r pic s9(32) comp-3. + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) comp-3 . + 01 varr pic 9(2) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) comp-3 . + 01 varr pic 9(4) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) comp-3 . + 01 varr pic 9(8) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) comp-3 . + 01 varr pic 9(16) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) comp-3 . + 01 varr pic 9(32) comp-3 . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.out new file mode 100644 index 00000000000..158cda12ec2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___COMP-3_BY_VALUE.out @@ -0,0 +1,11 @@ ++12 ++12 ++1234 ++1234 ++12345678 ++12345678 ++1234567890123456 ++1234567890123456 ++12345678901234567890123456789012 ++12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.cob new file mode 100644 index 00000000000..e0f1d8865e8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed___NumericDisplay_BY_REFERENCE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2). + 01 var16 pic s9(4). + 01 var32 pic s9(8). + 01 var64 pic s9(16). + 01 var128 pic s9(32). + 01 var8r pic s9(2). + 01 var16r pic s9(4). + 01 var32r pic s9(8). + 01 var64r pic s9(16). + 01 var128r pic s9(32). + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by reference var8 returning var8r + display var8r + display var16 + call "rvar16" using by reference var16 returning var16r + display var16r + display var32 + call "rvar32" using by reference var32 returning var32r + display var32r + display var64 + call "rvar64" using by reference var64 returning var64r + display var64r + display var128 + call "rvar128" using by reference var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) . + 01 varr pic 9(2) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) . + 01 varr pic 9(4) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) . + 01 varr pic 9(8) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) . + 01 varr pic 9(16) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) . + 01 varr pic 9(32) . + procedure division using by reference var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.out new file mode 100644 index 00000000000..158cda12ec2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_REFERENCE.out @@ -0,0 +1,11 @@ ++12 ++12 ++1234 ++1234 ++12345678 ++12345678 ++1234567890123456 ++1234567890123456 ++12345678901234567890123456789012 ++12345678901234567890123456789012 + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.cob b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.cob new file mode 100644 index 00000000000..ca110fcf04b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/USING_Signed___NumericDisplay_BY_VALUE.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var8 pic s9(2). + 01 var16 pic s9(4). + 01 var32 pic s9(8). + 01 var64 pic s9(16). + 01 var128 pic s9(32). + 01 var8r pic s9(2). + 01 var16r pic s9(4). + 01 var32r pic s9(8). + 01 var64r pic s9(16). + 01 var128r pic s9(32). + procedure division. + move 12 to var8 + move 1234 to var16 + move 12345678 to var32 + move 1234567890123456 to var64 + move 12345678901234567890123456789012 to var128 + display var8 + call "rvar8" using by value var8 returning var8r + display var8r + display var16 + call "rvar16" using by value var16 returning var16r + display var16r + display var32 + call "rvar32" using by value var32 returning var32r + display var32r + display var64 + call "rvar64" using by value var64 returning var64r + display var64r + display var128 + call "rvar128" using by value var128 returning var128r + display var128r + goback. + end program prog. + + identification division. + program-id. rvar8. + data division. + linkage section. + 01 var pic 9(2) . + 01 varr pic 9(2) . + procedure division using by value var returning varr. + move var to varr. + end program rvar8. + + identification division. + program-id. rvar16. + data division. + linkage section. + 01 var pic 9(4) . + 01 varr pic 9(4) . + procedure division using by value var returning varr. + move var to varr. + end program rvar16. + + identification division. + program-id. rvar32. + data division. + linkage section. + 01 var pic 9(8) . + 01 varr pic 9(8) . + procedure division using by value var returning varr. + move var to varr. + end program rvar32. + + identification division. + program-id. rvar64. + data division. + linkage section. + 01 var pic 9(16) . + 01 varr pic 9(16) . + procedure division using by value var returning varr. + move var to varr. + end program rvar64. + + identification division. + program-id. rvar128. + data division. + linkage section. + 01 var pic 9(32) . + 01 varr pic 9(32) . + procedure division using by value var returning varr. + move var to varr. + end program rvar128. + diff --git a/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.out b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.out new file mode 100644 index 00000000000..158cda12ec2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/USING_Signed___NumericDisplay_BY_VALUE.out @@ -0,0 +1,11 @@ ++12 ++12 ++1234 ++1234 ++12345678 ++12345678 ++1234567890123456 ++1234567890123456 ++12345678901234567890123456789012 ++12345678901234567890123456789012 + diff --git a/libgcobol/Makefile.am b/libgcobol/Makefile.am index 183ddbb5f31..ab4cb0c3908 100644 --- a/libgcobol/Makefile.am +++ b/libgcobol/Makefile.am @@ -92,6 +92,7 @@ AM_CXXFLAGS = $(XCFLAGS) AM_CXXFLAGS += $(WARN_CFLAGS) AM_CXXFLAGS += -DIN_TARGET_LIBS AM_CXXFLAGS += -fno-strict-aliasing +#AM_CXXFLAGS += -fstrict-aliasing -Wstrict-aliasing -Wstrict-aliasing=3 if ENABLE_DARWIN_AT_RPATH # Handle embedded rpaths for Darwin. diff --git a/libgcobol/Makefile.in b/libgcobol/Makefile.in index 864fd3cd163..a72c50f1034 100644 --- a/libgcobol/Makefile.in +++ b/libgcobol/Makefile.in @@ -112,6 +112,7 @@ POST_UNINSTALL = : build_triplet = @build@ host_triplet = @host@ target_triplet = @target@ +#AM_CXXFLAGS += -fstrict-aliasing -Wstrict-aliasing -Wstrict-aliasing=3 # Handle embedded rpaths for Darwin. @BUILD_LIBGCOBOL_TRUE@@ENABLE_DARWIN_AT_RPATH_TRUE@am__append_1 = -Wc,-nodefaultrpaths \ diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index 7a4bde67da0..3cc13e34589 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -8,6 +8,7 @@ * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above + * * Redistributions in binary form must reproduce the above * copyright notice, this list of conditions and the following disclaimer * in the documentation and/or other materials provided with the * distribution. @@ -11568,23 +11569,7 @@ __gg__fetch_call_by_value_value(const cblc_field_t *field, case FldFloat: { - switch(length) - { - case 4: - *PTRCAST(float, &retval) = *PTRCAST(float, data); - break; - - case 8: - *PTRCAST(double, &retval) = *PTRCAST(double, data); - break; - - case 16: - // *(_Float128 *)(&retval) = double(*(_Float128 *)data); - GCOB_FP128 t; - memcpy(&t, data, 16); - memcpy(&retval, &t, 16); - break; - } + memcpy(&retval, data, length); break; } @@ -11629,23 +11614,7 @@ __gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter) case FldFloat: { - switch(dest->capacity) - { - case 4: - *PTRCAST(float, dest->data) = *PTRCAST(float, (¶meter)); - break; - - case 8: - *PTRCAST(double, dest->data) = *PTRCAST(double, (¶meter)); - break; - - case 16: - // *(_Float128 *)(dest->data) = *(_Float128 *)¶meter; - GCOB_FP128 t; - memcpy(&t, ¶meter, 16); - memcpy(dest->data, &t, 16); - break; - } + memcpy(dest->data, ¶meter, dest->capacity); break; } @@ -11745,8 +11714,8 @@ __gg__unstring( const cblc_field_t *id1, // The string being unstring int tally = 0; size_t pointer = 1; size_t nreceiver; - size_t left; - size_t right; + size_t left=0; + size_t right=0; std::u32string str_id1; std::vector delimiters; @@ -14634,3 +14603,27 @@ __gg__convert(cblc_field_t *dest, __gg__adjust_dest_size(dest, len); } } + + +extern "C" +__int128 +__gg__look_at_int128(__int128 val128) + { + /* This silly-looking function is included here as an aide to debugging + code generated at compile time. Because it is difficult to use GDB on + code created via GENERIC tags (there is, after all, no source code), it's + necessary to use things like gg_printf to do print-statement debugging on + such code. But there is no provision in printf for outputting __int128 + values. So, I created this routine; during debugging I can generate a + call to it, and then with GDB (which can display __int128 values in + decimal) I can set a breakpoint here and see the value. */ + return val128; + } + +extern "C" +void * +__gg__look_at_pointer(void *ptr) + { + // See comment for __gg__look_at_int128 + return ptr; + } diff --git a/libgcobol/xmlparse.cc b/libgcobol/xmlparse.cc index e5424541581..f1e0794fee7 100644 --- a/libgcobol/xmlparse.cc +++ b/libgcobol/xmlparse.cc @@ -298,10 +298,12 @@ xml_event( const char event_name[], size_t len, const xmlChar * value ) { xml_event(event_name, len, text); } +namespace XML { + static inline void xml_event( const char event_name[], const xmlChar * value ) { char *text = reinterpret_cast(const_cast(value)); - xml_event(event_name, strlen(text), text); + ::xml_event(event_name, strlen(text), text); } /* @@ -327,7 +329,7 @@ static void cdataBlock(void * CTX, int len) { SAYSO_DATA(len, data); - xml_event("CONTENT-CHARACTERS", len, data); + ::xml_event("CONTENT-CHARACTERS", len, data); } static void characters(void * CTX, @@ -335,7 +337,7 @@ static void characters(void * CTX, int len) { SAYSO_DATA(len, data); - xml_event("CONTENT-CHARACTERS", len, data); + ::xml_event("CONTENT-CHARACTERS", len, data); } static void comment(void * CTX, const xmlChar * value) { @@ -781,4 +783,4 @@ __gg__xml_parse( const cblc_field_t *input_field, return erc; } - +} // end XML namespace