1 /* info.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 2002 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
4
5 This file is part of GNU Fortran.
6
7 GNU Fortran 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 Fortran 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 Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
20 02111-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
58 static const char *const ffeinfo_basictype_string_[]
59 =
60 {
61 #define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
62 #include "info-b.def"
63 #undef FFEINFO_BASICTYPE
64 };
65 static const char *const ffeinfo_kind_message_[]
66 =
67 {
68 #define FFEINFO_KIND(kwd,msgid,snam) msgid,
69 #include "info-k.def"
70 #undef FFEINFO_KIND
71 };
72 static const char *const ffeinfo_kind_string_[]
73 =
74 {
75 #define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
76 #include "info-k.def"
77 #undef FFEINFO_KIND
78 };
79 static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
80 static const char *const ffeinfo_kindtype_string_[]
81 =
82 {
83 "",
84 "1",
85 "2",
86 "3",
87 "4",
88 "5",
89 "6",
90 "7",
91 "8",
92 "*",
93 };
94 static const char *const ffeinfo_where_string_[]
95 =
96 {
97 #define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
98 #include "info-w.def"
99 #undef FFEINFO_WHERE
100 };
101 static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype];
102
103 /* Static functions (internal). */
104
105
106 /* Internal macros. */
107
108
109 /* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
110
111 ffeinfoBasictype i, j, k;
112 k = ffeinfo_basictype_combine(i,j);
113
114 Returns a type based on "standard" operation between two given types. */
115
116 ffeinfoBasictype
ffeinfo_basictype_combine(ffeinfoBasictype l,ffeinfoBasictype r)117 ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
118 {
119 assert (l < FFEINFO_basictype);
120 assert (r < FFEINFO_basictype);
121 return ffeinfo_combine_[l][r];
122 }
123
124 /* ffeinfo_basictype_string -- Return tiny string showing the basictype
125
126 ffeinfoBasictype i;
127 printf("%s",ffeinfo_basictype_string(dt));
128
129 Returns the string based on the basic type. */
130
131 const char *
ffeinfo_basictype_string(ffeinfoBasictype basictype)132 ffeinfo_basictype_string (ffeinfoBasictype basictype)
133 {
134 if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
135 return "?\?\?";
136 return ffeinfo_basictype_string_[basictype];
137 }
138
139 /* ffeinfo_init_0 -- Initialize
140
141 ffeinfo_init_0(); */
142
143 void
ffeinfo_init_0()144 ffeinfo_init_0 ()
145 {
146 ffeinfoBasictype i;
147 ffeinfoBasictype j;
148
149 assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
150 assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
151 assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
152 assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
153 assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
154
155 /* Make array that, given two basic types, produces resulting basic type. */
156
157 for (i = 0; i < FFEINFO_basictype; ++i)
158 for (j = 0; j < FFEINFO_basictype; ++j)
159 if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
160 ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
161 else
162 ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
163
164 #define same(bt) ffeinfo_combine_[bt][bt] = bt
165 #define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2] \
166 = ffeinfo_combine_[bt2][bt1] = bt2
167
168 same (FFEINFO_basictypeINTEGER);
169 same (FFEINFO_basictypeLOGICAL);
170 same (FFEINFO_basictypeREAL);
171 same (FFEINFO_basictypeCOMPLEX);
172 same (FFEINFO_basictypeCHARACTER);
173 use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
174 use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
175 use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
176
177 #undef same
178 #undef use2
179 }
180
181 /* ffeinfo_kind_message -- Return helpful string showing the kind
182
183 ffeinfoKind kind;
184 printf("%s",ffeinfo_kind_message(kind));
185
186 Returns the string based on the kind. */
187
188 const char *
ffeinfo_kind_message(ffeinfoKind kind)189 ffeinfo_kind_message (ffeinfoKind kind)
190 {
191 if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
192 return "?\?\?";
193 return ffeinfo_kind_message_[kind];
194 }
195
196 /* ffeinfo_kind_string -- Return tiny string showing the kind
197
198 ffeinfoKind kind;
199 printf("%s",ffeinfo_kind_string(kind));
200
201 Returns the string based on the kind. */
202
203 const char *
ffeinfo_kind_string(ffeinfoKind kind)204 ffeinfo_kind_string (ffeinfoKind kind)
205 {
206 if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
207 return "?\?\?";
208 return ffeinfo_kind_string_[kind];
209 }
210
211 ffeinfoKindtype
ffeinfo_kindtype_max(ffeinfoBasictype bt,ffeinfoKindtype k1,ffeinfoKindtype k2)212 ffeinfo_kindtype_max(ffeinfoBasictype bt,
213 ffeinfoKindtype k1,
214 ffeinfoKindtype k2)
215 {
216 if ((bt == FFEINFO_basictypeANY)
217 || (k1 == FFEINFO_kindtypeANY)
218 || (k2 == FFEINFO_kindtypeANY))
219 return FFEINFO_kindtypeANY;
220
221 if (ffetype_size (ffeinfo_types_[bt][k1])
222 > ffetype_size (ffeinfo_types_[bt][k2]))
223 return k1;
224 return k2;
225 }
226
227 /* ffeinfo_kindtype_string -- Return tiny string showing the kind type
228
229 ffeinfoKindtype kind_type;
230 printf("%s",ffeinfo_kindtype_string(kind));
231
232 Returns the string based on the kind type. */
233
234 const char *
ffeinfo_kindtype_string(ffeinfoKindtype kind_type)235 ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
236 {
237 if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
238 return "?\?\?";
239 return ffeinfo_kindtype_string_[kind_type];
240 }
241
242 void
ffeinfo_set_type(ffeinfoBasictype basictype,ffeinfoKindtype kindtype,ffetype type)243 ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
244 ffetype type)
245 {
246 assert (basictype < FFEINFO_basictype);
247 assert (kindtype < FFEINFO_kindtype);
248 assert (ffeinfo_types_[basictype][kindtype] == NULL);
249
250 ffeinfo_types_[basictype][kindtype] = type;
251 }
252
253 ffetype
ffeinfo_type(ffeinfoBasictype basictype,ffeinfoKindtype kindtype)254 ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
255 {
256 assert (basictype < FFEINFO_basictype);
257 assert (kindtype < FFEINFO_kindtype);
258
259 return ffeinfo_types_[basictype][kindtype];
260 }
261
262 /* ffeinfo_where_string -- Return tiny string showing the where
263
264 ffeinfoWhere where;
265 printf("%s",ffeinfo_where_string(where));
266
267 Returns the string based on the where. */
268
269 const char *
ffeinfo_where_string(ffeinfoWhere where)270 ffeinfo_where_string (ffeinfoWhere where)
271 {
272 if (where >= ARRAY_SIZE (ffeinfo_where_string_))
273 return "?\?\?";
274 return ffeinfo_where_string_[where];
275 }
276
277 /* ffeinfo_new -- Return object representing datatype, kind, and where info
278
279 ffeinfo i;
280 i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
281 FFEINFO_whereLOCAL);
282
283 Returns the string based on the data type. */
284
285 #ifndef __GNUC__
286 ffeinfo
ffeinfo_new(ffeinfoBasictype basictype,ffeinfoKindtype kindtype,ffeinfoRank rank,ffeinfoKind kind,ffeinfoWhere where,ffetargetCharacterSize size)287 ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
288 ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
289 ffetargetCharacterSize size)
290 {
291 ffeinfo i;
292
293 i.basictype = basictype;
294 i.kindtype = kindtype;
295 i.rank = rank;
296 i.size = size;
297 i.kind = kind;
298 i.where = where;
299 i.size = size;
300
301 return i;
302 }
303 #endif
304