Re: namelist

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

There are still a number of formatting issues in the patch.  I point out every
type of issue the first time it appears.

Paul Thomas wrote:
>     * io/io.h (nml_ls): Declare.
>     * io/io.h (namelist_info): Modify for arrays.

The canonical form is
      * io/io.h (nml_ls):Declare.
      (namelist_info): Modify for arrays.

>  * fortran/trans-io.c : Build library function for st_set_nml_var.
> * fortran/trans-io.c : Build library function for st_set_nml_var_dim.

      * fortran/trans-io.c (gfc_build_io_library_fndecls): Create declaration
      for st_set_nml_var, st_set_nml_var_dim.  Remove declaration of old
      namelist functions.

> ? fortran.diff
> ? fortran.patch

you get rid of these by using "cvs -q diff ..."

> --- 813,1038 ----
>      return nml_name;
>   }
>   
> ! /* nml_full_name builds up the fully qualified name of a
> !    derived type component. */
                              ^^ you're still lacking the second blank
> ! 
> ! static char*
> ! nml_full_name (const char* var_name, const char* cmp_name)
>   {
> !   int full_name_length;
> !   char * full_name;
> !   full_name_length = strlen (var_name) + strlen (cmp_name) + 1;

An empty line is required afterthe declarations.

> !   if (full_name_length > GFC_MAX_SYMBOL_LEN)
> !     gfc_error ("NAMELIST IO: concatenation of %s and %s "
> ! 	       "exceeds %d characters", var_name,
> ! 	       cmp_name, GFC_MAX_SYMBOL_LEN);

This is no problem.  It definitely shouldn't be in any case as both variable
names and component names may independently have GFC_MAX_SYMBOL_LEN long
names.  With nested derived types this becomes even more apparent.

> !   full_name = (char*)gfc_getmem (full_name_length + 1);
> !   strcpy (full_name, var_name);
> !   full_name = strcat (full_name, "%");
> !   full_name = strcat (full_name, cmp_name);
> !   return full_name;
> ! }
> ! 
> ! /* nml_get_addr_expr builds an address expression from the
> !    gfc_symbol or gfc_component backend_decl's. An offset is
> !    provided so that the address of an element of an array of
> !    derived types is returned. This is used in the runtime to
> !    determine that span of the derived type. */
>   
> ! static tree
> ! nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
> ! 		   tree base_addr)
> ! {
> !   tree decl = NULL_TREE;
> !   tree tmp, itmp;
> !   int fl_array, fl_dummy;
> !   if (sym)
> !     {
>     sym->attr.referenced = 1;
> +       decl = gfc_get_symbol_decl (sym);
> +     }
> +   else
> +     decl = c->backend_decl;
> +   gcc_assert (decl && ((TREE_CODE (decl) == FIELD_DECL
> + 		     || TREE_CODE (decl) == VAR_DECL
> + 		     || TREE_CODE (decl) == PARM_DECL)
> + 		     || TREE_CODE (decl) == COMPONENT_REF));
> + 
> +   tmp =decl;
           ^ missing space
> + 
> + /* Build indirect reference, if dummy argument. */
    ^^ Indent to same level as code
> + 
> +   fl_dummy = POINTER_TYPE_P (TREE_TYPE(tmp));
> +   itmp = (fl_dummy) ? gfc_build_indirect_ref (tmp) : tmp;
> + 
> + /* If an array, set flag and use indirect ref. if built. After
> +    building the component reference, if we have a derived type
> +    component, a reference to the first element of the array is
> +    built.  This is done so that base_addr, used in the build of
> +    the component reference, always points to a RECORD_TYPE. */
> + 
> +   fl_array = (TREE_CODE (TREE_TYPE (itmp)) == ARRAY_TYPE &&
                                                             ^^ next line
> + 	      !TYPE_STRING_FLAG (TREE_TYPE (itmp)));
>   
> !   if (fl_array)
> !     tmp = itmp;
> ! 
> !   if (TREE_CODE (decl) == FIELD_DECL)
> !     tmp = build3 (COMPONENT_REF, TREE_TYPE (tmp),
> ! 		  base_addr, tmp, NULL_TREE);
> ! 
> !   if (fl_array)
> !     tmp = gfc_build_array_ref (tmp, gfc_index_zero_node);
> ! 
> ! /* Now build the address expression, no matter what we have. */
> ! 
> !   tmp = gfc_build_addr_expr (NULL, tmp);
> ! 
> ! /* If scalar dummy, resolve indirect reference now. */
> ! 
> !   if (fl_dummy && !fl_array)
> !     tmp = gfc_build_indirect_ref (tmp);

Hm, can the function result be set from a namelist?  In this case this might
break.  I think you would be better served if you kept the se around the call
to transfer_namelist_element and passed it to transfer_namelist_element, and
then used gfc_conv_variable instead.  Or is there something I'm missing?  In
any case, I think an if with all four cases expanded would be more readable.

> ! 
> !   gcc_assert (tmp && POINTER_TYPE_P (TREE_TYPE (tmp)));
> ! 
> !   return tmp;
>   }
>   
> ! /* For an object VAR_NAME whose base address is BASE_ADDR, generate a
>      call to iocall_set_nml_val.  For derived type variable, recursively
> !    generate calls to iocall_set_nml_val for each component. */
>   
>   static void
> ! transfer_namelist_element (stmtblock_t * block, const char * var_name,
> ! 			   gfc_symbol * sym, gfc_component * c,
> ! 			   tree base_addr)
>   {
> !   gfc_typespec * ts = NULL;
> !   gfc_array_spec * as = NULL;
> !   tree addr_expr = NULL;
> !   tree dt = NULL;
>   
> !   tree string, tmp, args, dtype;
> !   int n_dim, itype, rank = 0;
>   
> !   gcc_assert (sym || c);
>   
> ! /* Build the namelist object name. */
>   
> !   string = gfc_build_cstring_const (var_name);
> !   string = gfc_build_addr_expr (pchar_type_node, string);
>   
> ! /* Build ts, as and data address using symbol or component. */
>   
> !   ts = (sym)? &sym->ts : &c->ts;
> !   as = (sym)? sym->as : c->as;
                ^^ blank before the '?'
> ! 
> !   addr_expr = nml_get_addr_expr (sym, c, base_addr);
> ! 
> !   if ( as ) rank = as->rank;
          ^  ^ ^ no blanks, newline before the statement please.
>   
> +   if (rank)
> +     {
> +       dt =  TREE_TYPE ((sym)? sym->backend_decl: c->backend_decl);
> +       dtype = gfc_get_dtype (dt);
> +     }
> +   else
> +     {
> +       itype = GFC_DTYPE_UNKNOWN;
>     switch (ts->type)
>       {
>       case BT_INTEGER:
> ! 	  itype = GFC_DTYPE_INTEGER;
>         break;
> ! 	case BT_LOGICAL:
> ! 	  itype = GFC_DTYPE_LOGICAL;
>         break;
>       case BT_REAL:
> ! 	  itype = GFC_DTYPE_REAL;
>         break;
> ! 	case BT_COMPLEX:
> ! 	  itype = GFC_DTYPE_COMPLEX;
>         break;
> + 	case BT_DERIVED:
> + 	  itype = GFC_DTYPE_DERIVED;
> + 	  break;
> + 	case BT_CHARACTER:
> + 	  itype = GFC_DTYPE_CHARACTER;
> + 	  break;
> + 	default:
> + 	  gfc_error("Bad type in namelist transfer");
> + 	}
> +       dtype = build_int_cst (gfc_array_index_type,
> + 			     itype << GFC_DTYPE_TYPE_SHIFT);
> +     }
>   
> + #define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a)
> + #define NML_ADD_ARG(a) args = gfc_chainon_list (args, a)
> + #define IARG(i) build_int_cst (gfc_array_index_type, i)
> + 
> + /* Build up the arguments for the transfer call.
> +    The call for the scalar part transfers:
> +    (address, name, type, kind or string_length, dtype) */
> + 
> +   NML_FIRST_ARG (addr_expr);
> +   NML_ADD_ARG (string);
> +   NML_ADD_ARG (IARG (ts->kind));
> +   switch(ts->type)
> +     {
> +     case BT_CHARACTER:
> +       NML_ADD_ARG (convert (gfc_array_index_type,
> + 			    ts->cl->backend_decl));
> +       break;
> +     case BT_INTEGER:
> +     case BT_REAL:
>       case BT_COMPLEX:
> !     case BT_LOGICAL:
> !     case BT_DERIVED:
> !       NML_ADD_ARG (integer_zero_node);
>         break;
> !     default:
> !       gfc_error("Bad type in namelist transfer");
          ^^^^^^^^^ gfc_unreachable ();

At this point all invalid code should have already been rejected.  If you
found a case where BT_PROCEDURE made it through to this code, then this is a
bug much earlier on, and needs to be fixed either when matching the namelist
or when resolving it.

>       }
> +   NML_ADD_ARG (dtype);
> +   tmp = gfc_build_function_call (iocall_set_nml_val, args);
> +   gfc_add_expr_to_block (block, tmp);
> + 
> + /* If the object is an array, transfer rank times:
> +    (null pointer, name, stride, lbound, ubound)  */
>   
> +   for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
> +     {
> +       NML_FIRST_ARG (IARG (n_dim));
> +       NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim));
> +       NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim));
> +       NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
> +       tmp = gfc_build_function_call (iocall_set_nml_val_dim, args);
>     gfc_add_expr_to_block (block, tmp);
> +     }
> + 
> +   if (ts->type == BT_DERIVED)
> +     {
> +       gfc_component *cmp;
> + 
> + /* Provide the RECORD_TYPE itself to build component references. */
> + 
> +       tree expr = gfc_build_indirect_ref (addr_expr);
> + 
> +       for (cmp = ts->derived->components; cmp; cmp = cmp->next)
> + 	{
> + 	  char *full_name = nml_full_name (var_name, cmp->name);
> + 	  transfer_namelist_element (block,
> + 				     full_name,
> + 				     NULL, cmp, expr);
> + 	  gfc_free (full_name);
> + 	}
> +     }
>   }
>   
> + #undef IARG
> + #undef NML_ADD_ARG
> + #undef NML_FIRST_ARG
> + 
>   /* Create a data transfer statement.  Not all of the fields are valid
>      for both reading and writing, but improper use has been filtered
>      out by now.  */
> *************** build_dt (tree * function, gfc_code * co
> *** 950,958 ****
>     stmtblock_t block, post_block;
>     gfc_dt *dt;
>     tree tmp;
> !   gfc_expr *nmlname, *nmlvar;
>     gfc_namelist *nml;
> -   gfc_se se,se2;
>   
>     gfc_init_block (&block);
>     gfc_init_block (&post_block);
> --- 1043,1050 ----
>     stmtblock_t block, post_block;
>     gfc_dt *dt;
>     tree tmp;
> !   gfc_expr *nmlname;
>     gfc_namelist *nml;
>   
>     gfc_init_block (&block);
>     gfc_init_block (&post_block);
> *************** build_dt (tree * function, gfc_code * co
> *** 1022,1039 ****
>             set_flag (&block, ioparm_namelist_read_mode);
>   
>   	for (nml = dt->namelist->namelist; nml; nml = nml->next)
> ! 	  {
> ! 	    gfc_init_se (&se, NULL);
> ! 	    gfc_init_se (&se2, NULL);
> ! 	    nmlvar = get_new_var_expr (nml->sym);
> ! 	    nmlname = gfc_new_nml_name_expr (nml->sym->name);
> ! 	    gfc_conv_expr_reference (&se2, nmlname);
> ! 	    gfc_conv_expr_reference (&se, nmlvar);
> ! 	    gfc_evaluate_now (se.expr, &se.pre); 
> ! 
> ! 	    transfer_namelist_element (&block, &nml->sym->ts, se.expr,
> ! 				       se2.expr, se2.string_length);
> ! 	  }
>       }
>   
>     tmp = gfc_build_function_call (*function, NULL_TREE);
> --- 1114,1121 ----
>             set_flag (&block, ioparm_namelist_read_mode);
>   
>   	for (nml = dt->namelist->namelist; nml; nml = nml->next)
> ! 	transfer_namelist_element (&block, nml->sym->name, nml->sym,
> ! 				   NULL, NULL);
>       }
>   
>     tmp = gfc_build_function_call (*function, NULL_TREE);
> 
> 
> *** io.h	16 Mar 2005 19:33:07 -0000	1.17
> --- io.h	7 Apr 2005 14:10:30 -0000
> *************** stream;
> *** 74,105 ****
>   #define sseek(s, pos) ((s)->seek)(s, pos)
>   #define struncate(s) ((s)->truncate)(s)
>   
> ! /* Namelist represent object */
> ! /*
> !    Namelist Records
> !        &groupname  object=value [,object=value].../
> !      or
> !        &groupname  object=value [,object=value]...&groupname
> ! 
> !   Even more complex, during the execution of a program containing a
> !   namelist READ statement, you can specify a question mark character(?)
> !   or a question mark character preceded by an equal sign(=?) to get
> !   the information of the namelist group. By '?', the name of variables
> !   in the namelist will be displayed, by '=?', the name and value of
> !   variables will be displayed.
> ! 
> !   All these requirements need a new data structure to record all info
> !   about the namelist.
> ! */
>   
>   typedef struct namelist_type
>   {
>     char * var_name;
>     void * mem_pos;
> !   int  value_acquired;
>     int len;
>     int string_length;
> !   bt type;
>     struct namelist_type * next;
>   }
>   namelist_info;
> --- 74,102 ----
>   #define sseek(s, pos) ((s)->seek)(s, pos)
>   #define struncate(s) ((s)->truncate)(s)
>   
> ! /* Namelist object representation*/
> ! 
> ! typedef struct nml_loop_spec
> ! {
> !   int idx;
> !   int start;
> !   int end;
> !   int step;
> ! }
> ! nml_loop_spec;
>   
>   typedef struct namelist_type
>   {
> +   bt type;
>     char * var_name;
>     void * mem_pos;
> !   int touched;
>     int len;
> +   int size;
>     int string_length;
> !   int var_rank;
> !   descriptor_dimension * dim;
> !   nml_loop_spec * ls;
>     struct namelist_type * next;
>   }
>   namelist_info;

An updated comment would be better than removing it completely.

I don't know the semantics of namelists nor the library itself well enough to
review the other parts of the patch.

- Tobi