1 files changed, 122 insertions, 127 deletions
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index be463f2..c91237b 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -787,13 +787,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;
     }
@@ -2354,34 +2354,25 @@ section_label(struct cbl_proc_t *procedure)
 
   cbl_label_t *label = procedure->label;
   // The _initialize_program section isn't relevant.
-  static size_t psz_length = 256;
-  static char *psz = (char *)xmalloc(psz_length);
-  sprintf(psz,
-          "# SECTION %s in %s (%ld)",
-          label->name,
-          current_function->our_unmangled_name,
-          deconflictor);
+  char *psz = xasprintf("# SECTION %s in %s (%ld)",
+                        label->name,
+                        current_function->our_unmangled_name,
+                        deconflictor);
   gg_insert_into_assembler(psz);
+  free(psz);
 
   // The label has to start with an underscore.  I tried a period, but those
   // don't seem to show up in GDB's internal symbol tables.
-  char *combined = combined_name(procedure->label);
-  if( psz_length < strlen(combined) + 36 + 1 )
-    {
-    free(psz);
-    psz_length = strlen(combined) + 36 + 1;
-    psz        = (char *)xmalloc(psz_length);
-    }
-  sprintf(psz,
-          "_sect.%s",
-          combined_name(procedure->label));
+  char *psz2 = xasprintf( "_sect.%s",
+                          combined_name(procedure->label));
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
-    SHOW_PARSE_TEXT(psz);
+    SHOW_PARSE_TEXT(psz2);
     SHOW_PARSE_END
     }
-  assembler_label(psz);
+  assembler_label(psz2);
+  free(psz2);
   gg_assign(var_decl_nop, build_int_cst_type(INT, 108));
   }
 
@@ -2410,40 +2401,32 @@ paragraph_label(struct cbl_proc_t *procedure)
   char *para_name    = paragraph->name;
   char *section_name = section ? section->name : nullptr;
 
-  static size_t psz_length = 256;
-  static char *psz = (char *)xmalloc(psz_length);
-
-  static size_t deconflictor = symbol_label_id(procedure->label);
-
-  sprintf(psz,
+  size_t deconflictor = symbol_label_id(procedure->label);
+  
+  char *psz1 = 
+  xasprintf(
           "# PARAGRAPH %s of %s in %s (%ld)",
-          para_name,
-          section_name,
-          current_function->our_unmangled_name,
-          deconflictor);
-  gg_insert_into_assembler(psz);
+          para_name ? para_name: "" ,
+          section_name ? section_name: "(null)" ,
+          current_function->our_unmangled_name ? current_function->our_unmangled_name: "" ,
+          deconflictor );
+  
+  gg_insert_into_assembler(psz1);
 
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
-    SHOW_PARSE_TEXT(psz);
+    SHOW_PARSE_TEXT(psz1);
     SHOW_PARSE_END
     }
+  free(psz1);
 
   // The label has to start with an underscore.  I tried a period, but those
   // don't seem to show up in GDB's internal symbol tables.
-  char *combined = combined_name(procedure->label);
-  if( psz_length < strlen(combined) + 36 + 1 )
-    {
-    free(psz);
-    psz_length = strlen(combined) + 36 + 1;
-    psz        = (char *)xmalloc(psz_length);
-    }
-
-  sprintf(psz,
-          "_para.%s",
-          combined_name(procedure->label));
-  assembler_label(psz);
+  char *psz2 = xasprintf( "_para.%s",
+                          combined_name(procedure->label));
+  assembler_label(psz2);
+  free(psz2);
   gg_assign(var_decl_nop, build_int_cst_type(INT, 109));
   }
 
@@ -2537,11 +2520,11 @@ leave_procedure(struct cbl_proc_t *procedure, bool /*section*/)
     // new program, or after somebody else has cleared it out.
     gg_append_statement(procedure->exit.label);
 
-    char ach[256];
-    sprintf(ach,
-            "_procret.%ld:",
-            symbol_label_id(procedure->label));
-    gg_insert_into_assembler(ach);
+    char *psz;
+    psz = xasprintf("_procret.%ld:",
+                    symbol_label_id(procedure->label));
+    gg_insert_into_assembler(psz);
+    free(psz);
     pseudo_return_pop(procedure);
     gg_append_statement(procedure->bottom.label);
     }
@@ -2650,7 +2633,6 @@ find_procedure(cbl_label_t *label)
   if( !retval )
     {
     static int counter=1;
-    char ach[2*sizeof(cbl_name_t)];
 
     // This is a new section or paragraph; we need to create its values:
     retval = (struct cbl_proc_t *)xmalloc(sizeof(struct cbl_proc_t));
@@ -2681,8 +2663,9 @@ find_procedure(cbl_label_t *label)
 
     // If this procedure is a paragraph, and it becomes the target of
     // an ALTER statement, alter_location will be used to make that change
-    sprintf(ach, "_%s_alter_loc_%d", label->name, counter);
-    retval->alter_location = gg_define_void_star(ach, vs_static);
+    char *psz = xasprintf("_%s_alter_loc_%d", label->name, counter);
+    retval->alter_location = gg_define_void_star(psz, vs_static);
+    free(psz);
     DECL_INITIAL(retval->alter_location) = null_pointer_node;
 
     counter +=1 ;
@@ -2884,10 +2867,10 @@ parser_goto( cbl_refer_t value_ref, size_t narg, cbl_label_t * const labels[] )
 
   // We need to create a static array of pointers to locations:
   static int comp_gotos = 1;
-  char ach[32];
-  sprintf(ach, "_comp_goto_%d", comp_gotos++);
+  char *psz = xasprintf("_comp_goto_%d", comp_gotos++);
   tree array_of_pointers_type = build_array_type_nelts(VOID_P, narg);
-  tree array_of_pointers = gg_define_variable(array_of_pointers_type, ach, vs_static);
+  tree array_of_pointers = gg_define_variable(array_of_pointers_type, psz, vs_static);
+  free(psz);
 
   // We have the array.  Now we need to build the constructor for it
   tree constr = make_node(CONSTRUCTOR);
@@ -3342,9 +3325,10 @@ parser_enter_file(const char *filename)
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
-    char ach[32];
-    sprintf(ach, " entering level:%d %s", file_level+1, filename);
-    SHOW_PARSE_TEXT(ach);
+    char *psz;
+    psz = xasprintf(" entering level:%d %s", file_level+1, filename);
+    SHOW_PARSE_TEXT(psz);
+    free(psz);
     SHOW_PARSE_END
     }
 
@@ -6663,7 +6647,10 @@ parser_division(cbl_division_t division,
 
           if( args[i].refer.field->attr & any_length_e )
             {
-            //gg_printf("side channel 0x%lx\n", gg_array_value(var_decl_call_parameter_lengths, rt_i), NULL_TREE);
+            // 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.
@@ -8819,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));
@@ -8926,8 +8917,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);
@@ -8938,8 +8929,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);
@@ -8951,7 +8942,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++ )
@@ -9695,7 +9686,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
     {
@@ -9846,7 +9839,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
     {
@@ -10124,6 +10119,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
@@ -11076,7 +11078,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));
@@ -11568,7 +11572,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));
@@ -12855,7 +12860,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
       {
@@ -15232,25 +15237,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,
@@ -15927,12 +15926,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);
@@ -16175,6 +16174,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
@@ -16769,55 +16772,47 @@ parser_symbol_add(struct cbl_field_t *new_var )
 
         if( bytes_to_allocate )
           {
-          if(    new_var->attr & (intermediate_e)
-              && new_var->type != FldLiteralN
-              && new_var->type != FldLiteralA )
+          // We need a unique name for the allocated data for this COBOL variable:
+          char achDataName[256];
+          if( new_var->attr & external_e )
+            {
+            sprintf(achDataName, "%s", new_var->name);
+            }
+          else if( new_var->name[0] == '_' )
             {
-            // We'll malloc() data in initialize_variable
-            data_area = null_pointer_node;
+            // Avoid doubling up on leading underscore
+            sprintf(achDataName,
+                    "%s_data_%lu",
+                    new_var->name,
+                    sv_data_name_counter++);
             }
           else
             {
-            // We need a unique name for the allocated data for this COBOL variable:
-            char achDataName[256];
-            if( new_var->attr & external_e )
-              {
-              sprintf(achDataName, "%s", new_var->name);
-              }
-            else if( new_var->name[0] == '_' )
-              {
-              // Avoid doubling up on leading underscore
-              sprintf(achDataName,
-                      "%s_data_%lu",
-                      new_var->name,
-                      sv_data_name_counter++);
-              }
-            else
-              {
-              sprintf(achDataName,
-                      "_%s_data_%lu",
-                      new_var->name,
-                      sv_data_name_counter++);
-              }
+            sprintf(achDataName,
+                    "_%s_data_%lu",
+                    new_var->name,
+                    sv_data_name_counter++);
+            }
 
-            if( new_var->attr & external_e )
-              {
-              tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
-              new_var->data_decl_node = gg_define_variable(
-                                  array_type,
-                                  achDataName,
-                                  vs_external);
-              data_area = gg_get_address_of(new_var->data_decl_node);
-              }
-            else
-              {
-              tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
-              new_var->data_decl_node = gg_define_variable(
-                                  array_type,
-                                  achDataName,
-                                  vs_static);
-              data_area = gg_get_address_of(new_var->data_decl_node);
-              }
+          if( new_var->attr & external_e )
+            {
+            tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
+            new_var->data_decl_node = gg_define_variable(
+                                array_type,
+                                achDataName,
+                                vs_external);
+            data_area = gg_get_address_of(new_var->data_decl_node);
+            }
+          else
+            {
+            gg_variable_scope_t vs_scope = (new_var->attr & intermediate_e)
+                                            ? vs_stack : vs_static ;
+            tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
+            new_var->data_decl_node = gg_define_variable(
+                                array_type,
+                                achDataName,
+                                vs_scope);
+            data_area = gg_get_address_of(new_var->data_decl_node);
             }
           }
         }