[gcc.git] / gcc / fortran / data.c

/* Supporting functions for resolving DATA statement.
   Copyright (C) 2002, 2003 Free Software Foundation, Inc.
   Contributed by Lifang Zeng <zlf605@hotmail.com>

This file is part of GNU G95.

GNU G95 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU G95 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU G95; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


/* Notes for DATA statement implementation:
                                                                                
   We first assign initial value to each symbol by gfc_assign_data_value
   during resolveing DATA statement. Refer to check_data_variable and
   traverse_data_list in resolve.c.
                                                                                
   The complexity exists in the handleing of array section, implied do
   and array of struct appeared in DATA statement.
                                                                                
   We call gfc_conv_structure, gfc_con_array_array_initializer,
   etc., to convert the initial value. Refer to trans-expr.c and
   trans-array.c.  */

#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "toplev.h"
#include "gfortran.h"
#include "assert.h"
#include "trans.h"

static void formalize_init_expr (gfc_expr *);

/* Calculate the array element offset.  */

static void
get_array_index (gfc_array_ref * ar, mpz_t * offset)
{
  gfc_expr *e;
  int i;
  try re;
  mpz_t delta;
  mpz_t tmp;

  mpz_init (tmp);
  mpz_set_si (*offset, 0);
  mpz_init_set_si (delta, 1);
  for (i = 0; i < ar->dimen; i++)
    {
      e = gfc_copy_expr (ar->start[i]);
      re = gfc_simplify_expr (e, 1);

      if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
	  || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
	  || (gfc_is_constant_expr (e) == 0))
	gfc_error ("non-constant array in DATA statement %L.", &ar->where);        
      mpz_set (tmp, e->value.integer);
      mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
      mpz_mul (tmp, tmp, delta);
      mpz_add (*offset, tmp, *offset);

      mpz_sub (tmp, ar->as->upper[i]->value.integer,
      ar->as->lower[i]->value.integer);
      mpz_add_ui (tmp, tmp, 1);
      mpz_mul (delta, tmp, delta);
    }
  mpz_clear (delta);
  mpz_clear (tmp);
}


/* Find if there is a constructor which offset is equal to OFFSET.  */

static gfc_constructor *
find_con_by_offset (mpz_t offset, gfc_constructor *con)
{
  for (; con; con = con->next)
    {
      if (mpz_cmp (offset, con->n.offset) == 0)
        return con;
    }
  return NULL;
}


/* Find if there is a constructor which component is equal to COM.  */

static gfc_constructor *
find_con_by_component (gfc_component *com, gfc_constructor *con)
{
  for (; con; con = con->next)
    {
      if (com == con->n.component)
        return con;
    }
  return NULL;
}


/* Assign the initial value RVALUE to  LVALUE's symbol->value.  */
void
gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
{
  gfc_ref *ref;
  gfc_expr *init;
  gfc_expr *expr;
  gfc_constructor *con;
  gfc_constructor *last_con;
  gfc_symbol *symbol;
  mpz_t offset;

  ref = lvalue->ref;
  symbol = lvalue->symtree->n.sym;
  init = symbol->value;
  last_con = NULL;
  mpz_init_set_si (offset, 0);

  for (ref = lvalue->ref; ref; ref = ref->next)
    {
      /* Use the existing initializer expression if it exists.  Otherwise
         create a new one.  */
      if (init == NULL)
	expr = gfc_get_expr ();
      else
	expr = init;

      /* Find or create this element.  */
      switch (ref->type)
	{
	case REF_ARRAY:
	  if (init == NULL)
	    {
	      /* Setup the expression to hold the constructor.  */
	      expr->expr_type = EXPR_ARRAY;
	      if (ref->next)
		{
		  assert (ref->next->type == REF_COMPONENT);
		  expr->ts.type = BT_DERIVED;
		}
	      else
		expr->ts = rvalue->ts;
	      expr->rank = ref->u.ar.as->rank;
	    }
	  else
	    assert (expr->expr_type == EXPR_ARRAY);

	  if (ref->u.ar.type == AR_ELEMENT)
	    get_array_index (&ref->u.ar, &offset);
	  else
	    mpz_set (offset, index);

	  /* Find the same element in the existing constructor.  */
	  con = expr->value.constructor;
	  con = find_con_by_offset (offset, con);

	  if (con == NULL)
	    {
	      /* Create a new constructor.  */
	      con = gfc_get_constructor();
	      mpz_set (con->n.offset, offset);
	      gfc_insert_constructor (expr, con);
	    }
	  break;

	case REF_COMPONENT:
	  if (init == NULL)
	    {
	      /* Setup the expression to hold the constructor.  */
	      expr->expr_type = EXPR_STRUCTURE;
	      expr->ts.type = BT_DERIVED;
	      expr->ts.derived = ref->u.c.sym;
	    }
	  else
	    assert (expr->expr_type == EXPR_STRUCTURE);

	  /* Find the same element in the existing constructor.  */
	  con = expr->value.constructor;
	  con = find_con_by_component (ref->u.c.component, con);

	  if (con == NULL)
	    {
	      /* Create a new constructor.  */
	      con = gfc_get_constructor ();
	      con->n.component = ref->u.c.component;
	      con->next = expr->value.constructor;
	      expr->value.constructor = con;
	    }
	  break;

	case REF_SUBSTRING:
	  gfc_todo_error ("Substring reference in DATA statement");

	default:
	  abort ();
	}

      if (init == NULL)
	{
	  /* Point the container at the new expression.  */
	  if (last_con == NULL)
	    symbol->value = expr;
	  else
	    last_con->expr = expr;
	}
      init = con->expr;
      last_con = con;
    }

  expr = gfc_copy_expr (rvalue);
  if (!gfc_compare_types (&lvalue->ts, &expr->ts))
    gfc_convert_type (expr, &lvalue->ts, 0);

  if (last_con == NULL)
    symbol->value = expr;
  else
    {
      assert (!last_con->expr);
      last_con->expr = expr;
    }
}


/* Modify the index of array section and re-calculate the array offset.  */

void 
gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
		     mpz_t *offset_ret)
{
  int i;
  mpz_t delta;
  mpz_t tmp; 
  bool forwards;
  int cmp;

  for (i = 0; i < ar->dimen; i++)
    {
      if (ar->dimen_type[i] != DIMEN_RANGE)
	continue;

      if (ar->stride[i])
	{
	  mpz_add (section_index[i], section_index[i],
		   ar->stride[i]->value.integer);
	if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
	  forwards = true;
	else
	  forwards = false;
	}
      else
	{
	  mpz_add_ui (section_index[i], section_index[i], 1);
	  forwards = true;
	}
      
      if (ar->end[i])
	cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
      else
	cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);

      if ((cmp > 0 && forwards)
	  || (cmp < 0 && ! forwards))
	{
          /* Reset index to start, then loop to advance the next index.  */
	  if (ar->start[i])
	    mpz_set (section_index[i], ar->start[i]->value.integer);
	  else
	    mpz_set (section_index[i], ar->as->lower[i]->value.integer);
	}
      else
	break;
    }

  mpz_set_si (*offset_ret, 0);
  mpz_init_set_si (delta, 1);
  mpz_init (tmp);
  for (i = 0; i < ar->dimen; i++)
    {
      mpz_sub (tmp, section_index[i], ar->as->lower[i]->value.integer);
      mpz_mul (tmp, tmp, delta);
      mpz_add (*offset_ret, tmp, *offset_ret);

      mpz_sub (tmp, ar->as->upper[i]->value.integer, 
               ar->as->lower[i]->value.integer);
      mpz_add_ui (tmp, tmp, 1);
      mpz_mul (delta, tmp, delta);
    }
  mpz_clear (tmp);
  mpz_clear (delta);
}


/* Rearrange a structure constructor so the elements are in the specified
   order.  Also insert NULL entries if neccessary.  */

static void
formalize_structure_cons (gfc_expr * expr)
{
  gfc_constructor *head;
  gfc_constructor *tail;
  gfc_constructor *cur;
  gfc_constructor *last;
  gfc_constructor *c;
  gfc_component *order;

  c = expr->value.constructor;

  /* Constructor is already fomalized.  */
  if (c->n.component == NULL)
    return;

  head = tail = NULL;
  for (order = expr->ts.derived->components; order; order = order->next)
    {
      /* Find the next component.  */
      last = NULL;
      cur = c;
      while (cur != NULL && cur->n.component != order)
	{
	  last = cur;
	  cur = cur->next;
	}

      if (cur == NULL)
	{
	  /* Create a new one.  */
	  cur = gfc_get_constructor ();
	}
      else
	{
	  /* Remove it from the chain.  */
	  if (last == NULL)
	    c = cur->next;
	  else
	    last->next = cur->next;
	  cur->next = NULL;

	  formalize_init_expr (cur->expr);
	}

      /* Add it to the new constructor.  */
      if (head == NULL)
	head = tail = cur;
      else
	{
	  tail->next = cur;
	  tail = tail->next;
	}
    }
  assert (c == NULL);
  expr->value.constructor = head;
}


/* Make sure an initialization expression is in normalized form.  Ie. all
   elements of the constructors are in the correct order.  */

static void
formalize_init_expr (gfc_expr * expr)
{
  expr_t type;
  gfc_constructor *c;

  if (expr == NULL)
    return;

  type = expr->expr_type;
  switch (type)
    {
    case EXPR_ARRAY:
      c = expr->value.constructor;
      while (c)
	{
	  formalize_init_expr (c->expr);
	  c = c->next;
	}
      break;

    case EXPR_STRUCTURE:
      formalize_structure_cons (expr);
      break;

    default:
      break;
    }
}


/* Resolve symbol's initial value after all data statement.  */

void
gfc_formalize_init_value (gfc_symbol *sym)
{
  formalize_init_expr (sym->value);
}


/* Get the integer value into RET_AS and SECTION from AS and AR, and return
   offset.  */
 
void
gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
{
  int i;
  mpz_t delta;
  mpz_t tmp;

  mpz_set_si (*offset, 0);
  mpz_init (tmp);
  mpz_init_set_si (delta, 1);
  for (i = 0; i < ar->dimen; i++)
    {
      mpz_init (section_index[i]);
      switch (ar->dimen_type[i])
	{
	case DIMEN_ELEMENT:
	case DIMEN_RANGE:
	  if (ar->start[i])
	    {
	      mpz_sub (tmp, ar->start[i]->value.integer,
		       ar->as->lower[i]->value.integer);
	      mpz_mul (tmp, tmp, delta);
	      mpz_add (*offset, tmp, *offset);
	      mpz_set (section_index[i], ar->start[i]->value.integer);
	    }
	  else
	      mpz_set (section_index[i], ar->as->lower[i]->value.integer);
	  break;

	case DIMEN_VECTOR:
	  gfc_todo_error ("Vectors sections in data statements");

	default:
	  abort ();
	}

      mpz_sub (tmp, ar->as->upper[i]->value.integer, 
               ar->as->lower[i]->value.integer);
      mpz_add_ui (tmp, tmp, 1);
      mpz_mul (delta, tmp, delta);
    }

  mpz_clear (tmp);
  mpz_clear (delta);
}
Commit	Line	Data
6de9cd9a DN	1	/* Supporting functions for resolving DATA statement.
	2	Copyright (C) 2002, 2003 Free Software Foundation, Inc.
	3	Contributed by Lifang Zeng <zlf605@hotmail.com>
	4
	5	This file is part of GNU G95.
	6
	7	GNU G95 is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 2, or (at your option)
	10	any later version.
	11
	12	GNU G95 is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with GNU G95; see the file COPYING. If not, write to
	19	the Free Software Foundation, 59 Temple Place - Suite 330,
	20	Boston, MA 02111-1307, USA. */
	21
	22
	23	/* Notes for DATA statement implementation:
	24
	25	We first assign initial value to each symbol by gfc_assign_data_value
	26	during resolveing DATA statement. Refer to check_data_variable and
	27	traverse_data_list in resolve.c.
	28
	29	The complexity exists in the handleing of array section, implied do
	30	and array of struct appeared in DATA statement.
	31
	32	We call gfc_conv_structure, gfc_con_array_array_initializer,
	33	etc., to convert the initial value. Refer to trans-expr.c and
	34	trans-array.c. */
	35
	36	#include "config.h"
	37	#include "system.h"
	38	#include "coretypes.h"
	39	#include "toplev.h"
	40	#include "gfortran.h"
	41	#include "assert.h"
	42	#include "trans.h"
	43
	44	static void formalize_init_expr (gfc_expr *);
	45
	46	/* Calculate the array element offset. */
	47
	48	static void
	49	get_array_index (gfc_array_ref * ar, mpz_t * offset)
	50	{
	51	gfc_expr *e;
	52	int i;
	53	try re;
	54	mpz_t delta;
	55	mpz_t tmp;
	56
	57	mpz_init (tmp);
	58	mpz_set_si (*offset, 0);
	59	mpz_init_set_si (delta, 1);
	60	for (i = 0; i < ar->dimen; i++)
	61	{
	62	e = gfc_copy_expr (ar->start[i]);
	63	re = gfc_simplify_expr (e, 1);
	64
65	if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
66	\|\| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
67	\|\| (gfc_is_constant_expr (e) == 0))
68	gfc_error ("non-constant array in DATA statement %L.", &ar->where);
69	mpz_set (tmp, e->value.integer);
70	mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
71	mpz_mul (tmp, tmp, delta);
72	mpz_add (offset, tmp, offset);
73
74	mpz_sub (tmp, ar->as->upper[i]->value.integer,
75	ar->as->lower[i]->value.integer);
76	mpz_add_ui (tmp, tmp, 1);
77	mpz_mul (delta, tmp, delta);
78	}
79	mpz_clear (delta);
80	mpz_clear (tmp);
81	}
82
83
84	/* Find if there is a constructor which offset is equal to OFFSET. */
85
86	static gfc_constructor *
87	find_con_by_offset (mpz_t offset, gfc_constructor *con)
88	{
89	for (; con; con = con->next)
90	{
91	if (mpz_cmp (offset, con->n.offset) == 0)
92	return con;
93	}
94	return NULL;
95	}
96
97
98	/* Find if there is a constructor which component is equal to COM. */
99
100	static gfc_constructor *
101	find_con_by_component (gfc_component com, gfc_constructor con)
102	{
103	for (; con; con = con->next)
104	{
105	if (com == con->n.component)
106	return con;
107	}
108	return NULL;
109	}
110
111
112	/* Assign the initial value RVALUE to LVALUE's symbol->value. */
113	void
114	gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
115	{
116	gfc_ref *ref;
117	gfc_expr *init;
118	gfc_expr *expr;
119	gfc_constructor *con;
120	gfc_constructor *last_con;
121	gfc_symbol *symbol;
122	mpz_t offset;
123
124	ref = lvalue->ref;
125	symbol = lvalue->symtree->n.sym;
126	init = symbol->value;
127	last_con = NULL;
128	mpz_init_set_si (offset, 0);
129
130	for (ref = lvalue->ref; ref; ref = ref->next)
131	{
132	/* Use the existing initializer expression if it exists. Otherwise
133	create a new one. */
134	if (init == NULL)
135	expr = gfc_get_expr ();
136	else
137	expr = init;
138
139	/* Find or create this element. */
140	switch (ref->type)
141	{
142	case REF_ARRAY:
143	if (init == NULL)
144	{
145	/* Setup the expression to hold the constructor. */
146	expr->expr_type = EXPR_ARRAY;
147	if (ref->next)
148	{
149	assert (ref->next->type == REF_COMPONENT);
150	expr->ts.type = BT_DERIVED;
151	}
152	else
153	expr->ts = rvalue->ts;
154	expr->rank = ref->u.ar.as->rank;
155	}
156	else
157	assert (expr->expr_type == EXPR_ARRAY);
158
159	if (ref->u.ar.type == AR_ELEMENT)
160	get_array_index (&ref->u.ar, &offset);
161	else
162	mpz_set (offset, index);
163
164	/* Find the same element in the existing constructor. */
165	con = expr->value.constructor;
166	con = find_con_by_offset (offset, con);
167
168	if (con == NULL)
169	{
170	/* Create a new constructor. */
171	con = gfc_get_constructor();
172	mpz_set (con->n.offset, offset);
173	gfc_insert_constructor (expr, con);
174	}
175	break;
176
177	case REF_COMPONENT:
178	if (init == NULL)
179	{
180	/* Setup the expression to hold the constructor. */
181	expr->expr_type = EXPR_STRUCTURE;
182	expr->ts.type = BT_DERIVED;
183	expr->ts.derived = ref->u.c.sym;
184	}
185	else
186	assert (expr->expr_type == EXPR_STRUCTURE);
187
188	/* Find the same element in the existing constructor. */
189	con = expr->value.constructor;
190	con = find_con_by_component (ref->u.c.component, con);
191
192	if (con == NULL)
193	{
194	/* Create a new constructor. */
195	con = gfc_get_constructor ();
196	con->n.component = ref->u.c.component;
197	con->next = expr->value.constructor;
198	expr->value.constructor = con;
199	}
200	break;
201
202	case REF_SUBSTRING:
203	gfc_todo_error ("Substring reference in DATA statement");
204
205	default:
206	abort ();
207	}
208
209	if (init == NULL)
210	{
211	/* Point the container at the new expression. */
212	if (last_con == NULL)
213	symbol->value = expr;
214	else
215	last_con->expr = expr;
216	}
217	init = con->expr;
218	last_con = con;
219	}
220
221	expr = gfc_copy_expr (rvalue);
222	if (!gfc_compare_types (&lvalue->ts, &expr->ts))
223	gfc_convert_type (expr, &lvalue->ts, 0);
224
225	if (last_con == NULL)
226	symbol->value = expr;
227	else
228	{
229	assert (!last_con->expr);
230	last_con->expr = expr;
231	}
232	}
233
234
235	/* Modify the index of array section and re-calculate the array offset. */
236
237	void
238	gfc_advance_section (mpz_t section_index, gfc_array_ref ar,
239	mpz_t *offset_ret)
240	{
241	int i;
242	mpz_t delta;
243	mpz_t tmp;
244	bool forwards;
245	int cmp;
246
247	for (i = 0; i < ar->dimen; i++)
248	{
249	if (ar->dimen_type[i] != DIMEN_RANGE)
250	continue;
251
252	if (ar->stride[i])
253	{
254	mpz_add (section_index[i], section_index[i],
255	ar->stride[i]->value.integer);
256	if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
257	forwards = true;
258	else
259	forwards = false;
260	}
261	else
262	{
263	mpz_add_ui (section_index[i], section_index[i], 1);
264	forwards = true;
265	}
266
267	if (ar->end[i])
268	cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
269	else
270	cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
271
272	if ((cmp > 0 && forwards)
273	\|\| (cmp < 0 && ! forwards))
274	{
275	/* Reset index to start, then loop to advance the next index. */
276	if (ar->start[i])
277	mpz_set (section_index[i], ar->start[i]->value.integer);
278	else
279	mpz_set (section_index[i], ar->as->lower[i]->value.integer);
280	}
281	else
282	break;
283	}
284
285	mpz_set_si (*offset_ret, 0);
286	mpz_init_set_si (delta, 1);
287	mpz_init (tmp);
288	for (i = 0; i < ar->dimen; i++)
289	{
290	mpz_sub (tmp, section_index[i], ar->as->lower[i]->value.integer);
291	mpz_mul (tmp, tmp, delta);
292	mpz_add (offset_ret, tmp, offset_ret);
293
294	mpz_sub (tmp, ar->as->upper[i]->value.integer,
295	ar->as->lower[i]->value.integer);
296	mpz_add_ui (tmp, tmp, 1);
297	mpz_mul (delta, tmp, delta);
298	}
299	mpz_clear (tmp);
300	mpz_clear (delta);
301	}
302
303
304	/* Rearrange a structure constructor so the elements are in the specified
305	order. Also insert NULL entries if neccessary. */
306
307	static void
308	formalize_structure_cons (gfc_expr * expr)
309	{
310	gfc_constructor *head;
311	gfc_constructor *tail;
312	gfc_constructor *cur;
313	gfc_constructor *last;
314	gfc_constructor *c;
315	gfc_component *order;
316
317	c = expr->value.constructor;
318
319	/* Constructor is already fomalized. */
320	if (c->n.component == NULL)
321	return;
322
323	head = tail = NULL;
324	for (order = expr->ts.derived->components; order; order = order->next)
325	{
326	/* Find the next component. */
327	last = NULL;
328	cur = c;
329	while (cur != NULL && cur->n.component != order)
330	{
331	last = cur;
332	cur = cur->next;
333	}
334
335	if (cur == NULL)
336	{
337	/* Create a new one. */
338	cur = gfc_get_constructor ();
339	}
340	else
341	{
342	/* Remove it from the chain. */
343	if (last == NULL)
344	c = cur->next;
345	else
346	last->next = cur->next;
347	cur->next = NULL;
348
349	formalize_init_expr (cur->expr);
350	}
351
352	/* Add it to the new constructor. */
353	if (head == NULL)
354	head = tail = cur;
355	else
356	{
357	tail->next = cur;
358	tail = tail->next;
359	}
360	}
361	assert (c == NULL);
362	expr->value.constructor = head;
363	}
364
365
366	/* Make sure an initialization expression is in normalized form. Ie. all
367	elements of the constructors are in the correct order. */
368
369	static void
370	formalize_init_expr (gfc_expr * expr)
371	{
372	expr_t type;
373	gfc_constructor *c;
374
375	if (expr == NULL)
376	return;
377
378	type = expr->expr_type;
379	switch (type)
380	{
381	case EXPR_ARRAY:
382	c = expr->value.constructor;
383	while (c)
384	{
385	formalize_init_expr (c->expr);
386	c = c->next;
387	}
388	break;
389
390	case EXPR_STRUCTURE:
391	formalize_structure_cons (expr);
392	break;
393
394	default:
395	break;
396	}
397	}
398
399
400	/* Resolve symbol's initial value after all data statement. */
401
402	void
403	gfc_formalize_init_value (gfc_symbol *sym)
404	{
405	formalize_init_expr (sym->value);
406	}
407
408
409	/* Get the integer value into RET_AS and SECTION from AS and AR, and return
410	offset. */
411
412	void
413	gfc_get_section_index (gfc_array_ref ar, mpz_t section_index, mpz_t *offset)
414	{
415	int i;
416	mpz_t delta;
417	mpz_t tmp;
418
419	mpz_set_si (*offset, 0);
420	mpz_init (tmp);
421	mpz_init_set_si (delta, 1);
422	for (i = 0; i < ar->dimen; i++)
423	{
424	mpz_init (section_index[i]);
425	switch (ar->dimen_type[i])
426	{
427	case DIMEN_ELEMENT:
428	case DIMEN_RANGE:
429	if (ar->start[i])
430	{
431	mpz_sub (tmp, ar->start[i]->value.integer,
432	ar->as->lower[i]->value.integer);
433	mpz_mul (tmp, tmp, delta);
434	mpz_add (offset, tmp, offset);
435	mpz_set (section_index[i], ar->start[i]->value.integer);
436	}
437	else
438	mpz_set (section_index[i], ar->as->lower[i]->value.integer);
439	break;
440
441	case DIMEN_VECTOR:
442	gfc_todo_error ("Vectors sections in data statements");
443
444	default:
445	abort ();
446	}
447
448	mpz_sub (tmp, ar->as->upper[i]->value.integer,
449	ar->as->lower[i]->value.integer);
450	mpz_add_ui (tmp, tmp, 1);
451	mpz_mul (delta, tmp, delta);
452	}
453
454	mpz_clear (tmp);
455	mpz_clear (delta);
456	}
457