From e9400aaa6fb4be5defef45a2d14d830b77800d51 Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Mon, 1 Jan 2024 14:12:23 -0500
Subject: [PATCH] Handles 128-bit and 64-bit BY VALUE
---
gcc/cobol/genapi.cc | 95 ++++++++++++++++++++++++++++++------------
libgcobol/libgcobol.cc | 12 ++----
2 files changed, 73 insertions(+), 34 deletions(-)
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index a65b0d1a6ea6..7021bbc7a419 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -5433,7 +5433,10 @@ parser_division(cbl_division_t division,
char ach[2*sizeof(cbl_name_t)];
sprintf(ach, "_p_%s", args[i].refer.field->name);
- chain_parameter_to_function(current_function->function_decl, VOID_P, ach);
+
+ size_t nchars = 0;
+ tree par_type = tree_type_from_field_type(args[i].refer.field, nchars);
+ chain_parameter_to_function(current_function->function_decl, par_type, ach);
}
if( nusing )
@@ -5501,13 +5504,50 @@ parser_division(cbl_division_t division,
if( args[i].crv == by_value_e )
{
- // 'parameter' is the 64-bit value that was placed on the stack
+ // 'parameter' is the 64-bit or 128-bit value that was placed on the stack
+
cbl_field_t *new_var = args[i].refer.field;
-
+
+ size_t nbytes;
+ tree_type_from_field_type(new_var, nbytes);
+ tree parm = gg_define_variable(INT128);
+
+ if( nbytes <= 8 )
+ {
+ // Our input is a 64-bit number
+ if( new_var->attr & signable_e )
+ {
+ IF( gg_bitwise_and( gg_cast(SIZE_T, parameter),
+ build_int_cst_type(SIZE_T, 0x8000000000000000ULL)),
+ ne_op,
+ gg_cast(SIZE_T, integer_zero_node) )
+ {
+ // Our input is a negative number
+ gg_assign(parm, gg_cast(INT128, integer_minus_one_node));
+ }
+ ELSE
+ {
+ // Our input is a positive number
+ gg_assign(parm, gg_cast(INT128, integer_zero_node));
+ }
+ ENDIF
+ }
+ else
+ {
+ // This is a 64-bit positive number:
+ gg_assign(parm, gg_cast(INT128, integer_zero_node));
+ }
+ }
+ // At this point, parm has been set to 0 or -1
+
+ gg_memcpy(gg_get_address_of(parm),
+ gg_get_address_of(parameter),
+ 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,
- vs_stack);
+ NULL,
+ vs_stack);
gg_assign( member(new_var->var_decl_node, "data"),
gg_get_address_of(data_decl_node) );
@@ -5516,7 +5556,7 @@ parser_division(cbl_division_t division,
"__gg__assign_value_from_stack",
2,
gg_get_address_of(new_var->var_decl_node),
- parameter);
+ parm);
}
else
{
@@ -10541,7 +10581,7 @@ parser_call( cbl_refer_t name,
int *allocated = NULL;
if(narg)
{
- arguments = (tree *)xmalloc(narg * sizeof(tree));
+ arguments = (tree *)xmalloc(2*narg * sizeof(tree));
allocated = (int * )xmalloc(narg * sizeof(int));
}
@@ -10550,6 +10590,7 @@ parser_call( cbl_refer_t name,
build_int_cst_type(INT, narg));
// Put the arguments onto the stack:
+ size_t arg_count = 0;
for( size_t i=0; i<narg; i++ )
{
allocated[i] = 0;
@@ -10589,7 +10630,7 @@ parser_call( cbl_refer_t name,
// Pass the pointer to the data location, so that the called program
// can both access and change the data.
- arguments[i] = location;
+ arguments[arg_count] = location;
// BY REFERENCE variables might be going into an ANY LENGTH
// linkage variable in the called program. So, just in case, we need
@@ -10610,12 +10651,12 @@ parser_call( cbl_refer_t name,
// We'll free this copy after the called program returns.
// Allocate the memory, and make the copy:
- arguments[i] = gg_define_char_star();
+ arguments[arg_count] = gg_define_char_star();
allocated[i] = 1;
- gg_assign(arguments[i], gg_malloc(length) ) ;
- gg_memcpy(arguments[i], location, length);
+ gg_assign(arguments[arg_count], gg_malloc(length) ) ;
+ gg_memcpy(arguments[arg_count], location, length);
- //gg_printf(">>>>>Calling %ld location is %p\n", build_int_cst_type(SIZE_T, i), arguments[i], NULL_TREE);
+ //gg_printf(">>>>>Calling %ld location is %p\n", build_int_cst_type(SIZE_T, i), arguments[arg_count], NULL_TREE);
// BY CONTENT variables might be going into an ANY LENGTH
// linkage variable in the called program. So, just in case, we need
@@ -10630,31 +10671,33 @@ parser_call( cbl_refer_t name,
// necessary.
if( (args[i].refer.field && args[i].refer.field->data.digits > 18)
- || (args[i].refer.field && args[i].refer.field->type == FldFloat
+ || ( args[i].refer.field
+ && args[i].refer.field->type == FldFloat
&& args[i].refer.field->data.capacity == 16 ) )
{
- arguments[i] = gg_define_variable(INT128);
- gg_assign(arguments[i],
+ arguments[arg_count] = gg_define_variable(INT128);
+ gg_assign(arguments[arg_count],
gg_cast(INT128,
gg_call_expr(
- INT128,
- "__gg__fetch_call_by_value_value",
- 1,
- gg_get_address_of(args[i].refer.refer_decl_node))));
+ INT128,
+ "__gg__fetch_call_by_value_value",
+ 1,
+ gg_get_address_of(args[i].refer.refer_decl_node))));
}
else
{
- arguments[i] = gg_define_size_t();
- gg_assign(arguments[i],
+ arguments[arg_count] = gg_define_size_t();
+ gg_assign(arguments[arg_count],
gg_cast(SIZE_T,
gg_call_expr(
- INT128,
- "__gg__fetch_call_by_value_value",
- 1,
- gg_get_address_of(args[i].refer.refer_decl_node))));
+ INT128,
+ "__gg__fetch_call_by_value_value",
+ 1,
+ gg_get_address_of(args[i].refer.refer_decl_node))));
}
break;
}
+ arg_count += 1;
}
gg_call(VOID,
@@ -10664,7 +10707,7 @@ parser_call( cbl_refer_t name,
tree call_expr = gg_call_expr_list( returned_value_type,
function_handle,
- narg,
+ arg_count,
arguments );
tree returned_value;
if( returned.field )
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 7c6bab358aef..9c335bbee32f 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -8192,7 +8192,7 @@ __gg__fetch_call_by_value_value(cblc_refer_t *var)
extern "C"
void
-__gg__assign_value_from_stack(cblc_field_t *dest, size_t parameter)
+__gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter)
{
switch(dest->type)
{
@@ -8204,10 +8204,6 @@ __gg__assign_value_from_stack(cblc_field_t *dest, size_t parameter)
{
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.
- *(char *)dest->data = *(char *)parameter;
}
break;
@@ -8216,15 +8212,15 @@ __gg__assign_value_from_stack(cblc_field_t *dest, size_t parameter)
switch(dest->capacity)
{
case 4:
- *(float *)(dest->data) = *(float *)parameter;
+ *(float *)(dest->data) = *(float *)¶meter;
break;
case 8:
- *(double *)(dest->data) = *(double *)parameter;
+ *(double *)(dest->data) = *(double *)¶meter;
break;
case 16:
- *(_Float128 *)(dest->data) = *(_Float128 *)parameter;
+ *(_Float128 *)(dest->data) = *(_Float128 *)¶meter;
break;
}
break;
--
GitLab