gcc/f/info.c

   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
   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,LNAM,SNAM) LNAM,
  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   = { { NULL } };
 103
 104 /* Static functions (internal). */
 105
 106
 107 /* Internal macros. */
 108 \f
 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
 117 ffeinfoBasictype
 118 ffeinfo_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
 132 const char *
 133 ffeinfo_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
 144 void
 145 ffeinfo_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
 189 const char *
 190 ffeinfo_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
 204 const char *
 205 ffeinfo_kind_string (ffeinfoKind kind)
 206 {
 207   if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
 208     return "?\?\?";
 209   return ffeinfo_kind_string_[kind];
 210 }
 211
 212 ffeinfoKindtype
 213 ffeinfo_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
 235 const char *
 236 ffeinfo_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
 243 void
 244 ffeinfo_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
 254 ffetype
 255 ffeinfo_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
 270 const char *
 271 ffeinfo_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__
 287 ffeinfo
 288 ffeinfo_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