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