diff options
Diffstat (limited to 'gcc/cobol/genapi.cc')
| -rw-r--r-- | gcc/cobol/genapi.cc | 35 |
1 files changed, 22 insertions, 13 deletions
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 4d958cf..fbe0bbc 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -8806,6 +8806,10 @@ static void set_user_status(struct cbl_file_t *file) { // This routine sets the user_status, if any, to the cblc_file_t::status + + // We have to do it this way, because in the case where the file->user_status + // is in linkage, the memory addresses can end up pointing to the wrong + // places if(file->user_status) { cbl_field_t *user_status = cbl_field_of(symbol_at(file->user_status)); @@ -10111,6 +10115,13 @@ parser_intrinsic_subst( cbl_field_t *f, SHOW_PARSE { SHOW_PARSE_HEADER + SHOW_PARSE_FIELD(" TO ", f) + for(size_t i=0; i<argc; i++) + { + SHOW_PARSE_INDENT + SHOW_PARSE_FIELD(" ", argv[i].orig.field) + SHOW_PARSE_FIELD(" ", argv[i].replacement.field) + } SHOW_PARSE_END } TRACE1 @@ -15219,25 +15230,19 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, FIXED_WIDE_INT(128) i = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED); - /* ??? Use native_encode_* below. */ retval = (char *)xmalloc(field->data.capacity); switch(field->data.capacity) { + tree type; case 1: - *(signed char *)retval = (signed char)i.slow (); - break; case 2: - *(signed short *)retval = (signed short)i.slow (); - break; case 4: - *(signed int *)retval = (signed int)i.slow (); - break; case 8: - *(signed long *)retval = (signed long)i.slow (); - break; case 16: - *(unsigned long *)retval = (unsigned long)i.ulow (); - *((signed long *)retval + 1) = (signed long)i.shigh (); + type = build_nonstandard_integer_type (field->data.capacity + * BITS_PER_UNIT, 0); + native_encode_wide_int (type, i, (unsigned char *)retval, + field->data.capacity); break; default: fprintf(stderr, @@ -15914,12 +15919,12 @@ psa_global(cbl_field_t *new_var) if( strcmp(new_var->name, "RETURN-CODE") == 0 ) { - strcpy(ach, "__gg___11_return_code6"); + strcpy(ach, "__gg__return_code"); } if( strcmp(new_var->name, "UPSI-0") == 0 ) { - strcpy(ach, "__gg___6_upsi_04"); + strcpy(ach, "__gg__upsi"); } new_var->var_decl_node = gg_declare_variable(cblc_field_type_node, ach, NULL, vs_external_reference); @@ -16162,6 +16167,10 @@ psa_FldLiteralA(struct cbl_field_t *field ) field->data.initial, NULL_TREE, field->var_decl_node); + TREE_READONLY(field->var_decl_node) = 1; + TREE_USED(field->var_decl_node) = 1; + TREE_STATIC(field->var_decl_node) = 1; + DECL_PRESERVE_P (field->var_decl_node) = 1; nvar += 1; } TRACE1 |