home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / info.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  7KB  |  289 lines
  1. /* info.c -- Implementation File (module.c template V1.0)
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  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, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.    Related Modules:
  22.       None
  23.  
  24.    Description:
  25.       An abstraction for information maintained on a per-operator and per-
  26.       operand basis in expression trees.
  27.  
  28.    Modifications:
  29.       30-Aug-90     JCB  2.0
  30.      Extensive rewrite for new cleaner approach.
  31. */
  32.  
  33. /* Include files. */
  34.  
  35. #include "proj.h"
  36. #include "info.h"
  37. #include "target.h"
  38. #include "type.h"
  39.  
  40. /* Externals defined here. */
  41.  
  42.  
  43. /* Simple definitions and enumerations. */
  44.  
  45.  
  46. /* Internal typedefs. */
  47.  
  48.  
  49. /* Private include files. */
  50.  
  51.  
  52. /* Internal structure definitions. */
  53.  
  54.  
  55. /* Static objects accessed by functions in this module.     */
  56.  
  57. static char *ffeinfo_basictype_string_[]
  58. =
  59. {
  60. #define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
  61. #include "info-b.def"
  62. #undef FFEINFO_BASICTYPE
  63. };
  64. static char *ffeinfo_kind_message_[]
  65. =
  66. {
  67. #define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM,
  68. #include "info-k.def"
  69. #undef FFEINFO_KIND
  70. };
  71. static char *ffeinfo_kind_string_[]
  72. =
  73. {
  74. #define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
  75. #include "info-k.def"
  76. #undef FFEINFO_KIND
  77. };
  78. static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
  79. static char *ffeinfo_kindtype_string_[]
  80. =
  81. {
  82.   "",
  83.   "1",
  84.   "2",
  85.   "3",
  86.   "4",
  87.   "5",
  88.   "6",
  89.   "7",
  90.   "8",
  91.   "*",
  92. };
  93. static char *ffeinfo_where_string_[]
  94. =
  95. {
  96. #define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
  97. #include "info-w.def"
  98. #undef FFEINFO_WHERE
  99. };
  100. static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype]
  101.   = { { NULL } };
  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
  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. 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. 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. 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. /* ffeinfo_kindtype_string -- Return tiny string showing the kind type
  212.  
  213.    ffeinfoKindtype kind_type;
  214.    printf("%s",ffeinfo_kindtype_string(kind));
  215.  
  216.    Returns the string based on the kind type.  */
  217.  
  218. char *
  219. ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
  220. {
  221.   if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
  222.     return "?\?\?";
  223.   return ffeinfo_kindtype_string_[kind_type];
  224. }
  225.  
  226. void
  227. ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
  228.           ffetype type)
  229. {
  230.   assert (basictype < FFEINFO_basictype);
  231.   assert (kindtype < FFEINFO_kindtype);
  232.   assert (ffeinfo_types_[basictype][kindtype] == NULL);
  233.  
  234.   ffeinfo_types_[basictype][kindtype] = type;
  235. }
  236.  
  237. ffetype
  238. ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
  239. {
  240.   assert (basictype < FFEINFO_basictype);
  241.   assert (kindtype < FFEINFO_kindtype);
  242.   assert (ffeinfo_types_[basictype][kindtype] != NULL);
  243.  
  244.   return ffeinfo_types_[basictype][kindtype];
  245. }
  246.  
  247. /* ffeinfo_where_string -- Return tiny string showing the where
  248.  
  249.    ffeinfoWhere where;
  250.    printf("%s",ffeinfo_where_string(where));
  251.  
  252.    Returns the string based on the where.  */
  253.  
  254. char *
  255. ffeinfo_where_string (ffeinfoWhere where)
  256. {
  257.   if (where >= ARRAY_SIZE (ffeinfo_where_string_))
  258.     return "?\?\?";
  259.   return ffeinfo_where_string_[where];
  260. }
  261.  
  262. /* ffeinfo_new -- Return object representing datatype, kind, and where info
  263.  
  264.    ffeinfo i;
  265.    i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
  266.        FFEINFO_whereLOCAL);
  267.  
  268.    Returns the string based on the data type.  */
  269.  
  270. #if 0
  271. ffeinfo
  272. ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
  273.          ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
  274.          ffetargetCharacterSize size)
  275. {
  276.   ffeinfo i;
  277.  
  278.   i.basictype = basictype;
  279.   i.kindtype = kindtype;
  280.   i.rank = rank;
  281.   i.size = size;
  282.   i.kind = kind;
  283.   i.where = where;
  284.   i.size = size;
  285.  
  286.   return i;
  287. }
  288. #endif
  289.