gcc/f/info.c

   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 \f
 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
 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 *
 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
 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 *
 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 *
 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
 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 *
 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
 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
 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 *
 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
 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