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