1/* info.c -- Implementation File (module.c template V1.0)
2   Copyright (C) 1995 Free Software Foundation, Inc.
3   Contributed by James Craig Burley.
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING.  If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-1307, USA.
21
22   Related Modules:
23      None
24
25   Description:
26      An abstraction for information maintained on a per-operator and per-
27      operand basis in expression trees.
28
29   Modifications:
30      30-Aug-90	 JCB  2.0
31	 Extensive rewrite for new cleaner approach.
32*/
33
34/* Include files. */
35
36#include "proj.h"
37#include "info.h"
38#include "target.h"
39#include "type.h"
40
41/* Externals defined here. */
42
43
44/* Simple definitions and enumerations. */
45
46
47/* Internal typedefs. */
48
49
50/* Private include files. */
51
52
53/* Internal structure definitions. */
54
55
56/* Static objects accessed by functions in this module.	 */
57
58static const char *ffeinfo_basictype_string_[]
59=
60{
61#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
62#include "info-b.def"
63#undef FFEINFO_BASICTYPE
64};
65static const char *ffeinfo_kind_message_[]
66=
67{
68#define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM,
69#include "info-k.def"
70#undef FFEINFO_KIND
71};
72static const char *ffeinfo_kind_string_[]
73=
74{
75#define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
76#include "info-k.def"
77#undef FFEINFO_KIND
78};
79static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
80static const char *ffeinfo_kindtype_string_[]
81=
82{
83  "",
84  "1",
85  "2",
86  "3",
87  "4",
88  "5",
89  "6",
90  "7",
91  "8",
92  "*",
93};
94static const char *ffeinfo_where_string_[]
95=
96{
97#define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
98#include "info-w.def"
99#undef FFEINFO_WHERE
100};
101static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype]
102  = { { NULL } };
103
104/* Static functions (internal). */
105
106
107/* Internal macros. */
108
109
110/* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
111
112   ffeinfoBasictype i, j, k;
113   k = ffeinfo_basictype_combine(i,j);
114
115   Returns a type based on "standard" operation between two given types.  */
116
117ffeinfoBasictype
118ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
119{
120  assert (l < FFEINFO_basictype);
121  assert (r < FFEINFO_basictype);
122  return ffeinfo_combine_[l][r];
123}
124
125/* ffeinfo_basictype_string -- Return tiny string showing the basictype
126
127   ffeinfoBasictype i;
128   printf("%s",ffeinfo_basictype_string(dt));
129
130   Returns the string based on the basic type.	*/
131
132const char *
133ffeinfo_basictype_string (ffeinfoBasictype basictype)
134{
135  if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
136    return "?\?\?";
137  return ffeinfo_basictype_string_[basictype];
138}
139
140/* ffeinfo_init_0 -- Initialize
141
142   ffeinfo_init_0();  */
143
144void
145ffeinfo_init_0 ()
146{
147  ffeinfoBasictype i;
148  ffeinfoBasictype j;
149
150  assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
151  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
152  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
153  assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
154  assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
155
156  /* Make array that, given two basic types, produces resulting basic type. */
157
158  for (i = 0; i < FFEINFO_basictype; ++i)
159    for (j = 0; j < FFEINFO_basictype; ++j)
160      if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
161	ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
162      else
163	ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
164
165#define same(bt) ffeinfo_combine_[bt][bt] = bt
166#define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2]  \
167      = ffeinfo_combine_[bt2][bt1] = bt2
168
169  same (FFEINFO_basictypeINTEGER);
170  same (FFEINFO_basictypeLOGICAL);
171  same (FFEINFO_basictypeREAL);
172  same (FFEINFO_basictypeCOMPLEX);
173  same (FFEINFO_basictypeCHARACTER);
174  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
175  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
176  use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
177
178#undef same
179#undef use2
180}
181
182/* ffeinfo_kind_message -- Return helpful string showing the kind
183
184   ffeinfoKind kind;
185   printf("%s",ffeinfo_kind_message(kind));
186
187   Returns the string based on the kind.  */
188
189const char *
190ffeinfo_kind_message (ffeinfoKind kind)
191{
192  if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
193    return "?\?\?";
194  return ffeinfo_kind_message_[kind];
195}
196
197/* ffeinfo_kind_string -- Return tiny string showing the kind
198
199   ffeinfoKind kind;
200   printf("%s",ffeinfo_kind_string(kind));
201
202   Returns the string based on the kind.  */
203
204const char *
205ffeinfo_kind_string (ffeinfoKind kind)
206{
207  if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
208    return "?\?\?";
209  return ffeinfo_kind_string_[kind];
210}
211
212ffeinfoKindtype
213ffeinfo_kindtype_max(ffeinfoBasictype bt,
214		     ffeinfoKindtype k1,
215		     ffeinfoKindtype k2)
216{
217  if ((bt == FFEINFO_basictypeANY)
218      || (k1 == FFEINFO_kindtypeANY)
219      || (k2 == FFEINFO_kindtypeANY))
220    return FFEINFO_kindtypeANY;
221
222  if (ffetype_size (ffeinfo_types_[bt][k1])
223      > ffetype_size (ffeinfo_types_[bt][k2]))
224    return k1;
225  return k2;
226}
227
228/* ffeinfo_kindtype_string -- Return tiny string showing the kind type
229
230   ffeinfoKindtype kind_type;
231   printf("%s",ffeinfo_kindtype_string(kind));
232
233   Returns the string based on the kind type.  */
234
235const char *
236ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
237{
238  if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
239    return "?\?\?";
240  return ffeinfo_kindtype_string_[kind_type];
241}
242
243void
244ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
245		  ffetype type)
246{
247  assert (basictype < FFEINFO_basictype);
248  assert (kindtype < FFEINFO_kindtype);
249  assert (ffeinfo_types_[basictype][kindtype] == NULL);
250
251  ffeinfo_types_[basictype][kindtype] = type;
252}
253
254ffetype
255ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
256{
257  assert (basictype < FFEINFO_basictype);
258  assert (kindtype < FFEINFO_kindtype);
259
260  return ffeinfo_types_[basictype][kindtype];
261}
262
263/* ffeinfo_where_string -- Return tiny string showing the where
264
265   ffeinfoWhere where;
266   printf("%s",ffeinfo_where_string(where));
267
268   Returns the string based on the where.  */
269
270const char *
271ffeinfo_where_string (ffeinfoWhere where)
272{
273  if (where >= ARRAY_SIZE (ffeinfo_where_string_))
274    return "?\?\?";
275  return ffeinfo_where_string_[where];
276}
277
278/* ffeinfo_new -- Return object representing datatype, kind, and where info
279
280   ffeinfo i;
281   i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
282       FFEINFO_whereLOCAL);
283
284   Returns the string based on the data type.  */
285
286#ifndef __GNUC__
287ffeinfo
288ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
289	     ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
290	     ffetargetCharacterSize size)
291{
292  ffeinfo i;
293
294  i.basictype = basictype;
295  i.kindtype = kindtype;
296  i.rank = rank;
297  i.size = size;
298  i.kind = kind;
299  i.where = where;
300  i.size = size;
301
302  return i;
303}
304#endif
305