This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: namelist
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: Paul Thomas <paulthomas2 at wanadoo dot fr>
- Cc: fortran at gcc dot gnu dot org
- Date: Thu, 07 Apr 2005 23:44:39 +0200
- Subject: Re: namelist
- References: <42555D81.2090602@wanadoo.fr>
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