Open64: osprey/common/com/ttype.cxx Source File

00001 /*
00002  * Copyright 2003, 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
00003  */
00004 
00005 /*
00006 
00007   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00008 
00009   This program is free software; you can redistribute it and/or modify it
00010   under the terms of version 2 of the GNU General Public License as
00011   published by the Free Software Foundation.
00012 
00013   This program is distributed in the hope that it would be useful, but
00014   WITHOUT ANY WARRANTY; without even the implied warranty of
00015   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00016 
00017   Further, this software is distributed without any warranty that it is
00018   free of the rightful claim of any third person regarding infringement 
00019   or the like.  Any license provided herein, whether implied or 
00020   otherwise, applies only to this software file.  Patent licenses, if 
00021   any, provided herein do not apply to combinations of this program with 
00022   other software, or any other product whatsoever.  
00023 
00024   You should have received a copy of the GNU General Public License along
00025   with this program; if not, write the Free Software Foundation, Inc., 59
00026   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00027 
00028   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00029   Mountain View, CA 94043, or:
00030 
00031   http://www.sgi.com
00032 
00033   For further information regarding this notice, see:
00034 
00035   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00036 
00037 */
00038 
00039 
00040 /* ====================================================================
00041  * ====================================================================
00042  *
00043  * Module: ttype.c
00044  * $Revision: 1.1.1.1 $
00045  * $Date: 2005/10/21 19:00:00 $
00046  * $Author: marcel $
00047  * $Source: /proj/osprey/CVS/open64/osprey1.0/common/com/ttype.cxx,v $
00048  *
00049  * Revision history:
00050  *  26-May-89 - Original version of header.
00051  *  12-Jun-91 - Integrated from Josie
00052  *
00053  * Description:
00054  *
00055  * Map tree nodes to the types of the objects represented.
00056  *
00057  * ====================================================================
00058  * ====================================================================
00059  */
00060 
00061 #ifdef USE_PCH
00062 #include "common_com_pch.h"
00063 #endif /* USE_PCH */
00064 #pragma hdrstop
00065 #include "defs.h"
00066 #include "config.h"
00067 #include "erglob.h"
00068 
00069 #include "strtab.h"
00070 #include "stab.h"
00071 #include "opcode.h"
00072 #include "targ_const.h"
00073 #include "const.h"
00074 #include "wn_core.h"
00075 #include "ttype.h"
00076 
00077 #ifdef FRONT_F90
00078 #include "wn.h"
00079 #include "wn_simp.h"
00080 #endif
00081 
00082 TPDEF *Global_Tpdefs = NULL;
00083 
00084 #ifdef FRONT_END_FORTRAN
00085 
00086 TY *Fe_Type_Tbl_[FETYPE_LAST+1];
00087 
00088 /* ====================================================================
00089  *
00090  * FE_Type_Name
00091  *
00092  * Return a printable (character string) representation of
00093  * the FETYPE number of input TY.
00094  *
00095  * ====================================================================
00096  */
00097 
00098 char *
00099 FE_Type_Name ( TY *ty )
00100 {
00101   if ( ty == NULL )  return "<null TY>";
00102   if ( TY_kind(ty) != KIND_SCALAR )  return Kind_Name(TY_kind(ty));
00103 
00104   switch ( TY_fe_btype(ty) ) {
00105     case FETYPE_BAD:  return "FETYPE_BAD";
00106     case FETYPE_UNK:  return "FETYPE_UNK";
00107     case FETYPE_NONE: return "FETYPE_NONE";
00108     case FETYPE_L1: return "FETYPE_L1";
00109     case FETYPE_L2: return "FETYPE_L2";
00110     case FETYPE_L4: return "FETYPE_L4";
00111     case FETYPE_L8: return "FETYPE_L8";
00112     case FETYPE_I1: return "FETYPE_I1";
00113     case FETYPE_I2: return "FETYPE_I2";
00114     case FETYPE_I4: return "FETYPE_I4";
00115     case FETYPE_I8: return "FETYPE_I8";
00116     case FETYPE_R4: return "FETYPE_R4";
00117     case FETYPE_R8: return "FETYPE_R8";
00118     case FETYPE_R16:  return "FETYPE_R16";
00119     case FETYPE_C8: return "FETYPE_C8";
00120     case FETYPE_C16:  return "FETYPE_C16";
00121     case FETYPE_C32:  return "FETYPE_C32";
00122     case FETYPE_CH: return "FETYPE_CH";
00123   }
00124 
00125   return "<unknown scalar TY>";
00126 }
00127 #endif /* FRONT_END_FORTRAN */
00128 
00129 
00130 /* ====================================================================
00131  *
00132  * TY *TY_Of_Expr (WN *expr)
00133  *
00134  * Return the ty for a whirl expression 
00135  *
00136  * ====================================================================
00137  */
00138 
00139 TY_IDX
00140 TY_Of_Expr (const WN *expr)
00141 {
00142     TY_IDX type;
00143 
00144     switch (WN_operator(expr)) {
00145     case OPR_PARM:
00146   type = WN_ty(expr);
00147   break;
00148     case OPR_IDNAME:
00149   type = WN_type(expr);
00150   break;
00151     case OPR_MLOAD:
00152   type = TY_pointed (Ty_Table[WN_ty (expr)]);
00153   break;
00154     default:
00155   type = MTYPE_To_TY(WN_rtype(expr));
00156   break;
00157     }
00158 
00159     TYPE_ID mtype = TY_mtype (type);
00160 
00161     if (MTYPE_is_complex (mtype)) 
00162   return MTYPE_To_TY (mtype);
00163     
00164     return type;
00165 }
00166 
00167 /* ====================================================================
00168  *
00169  * TY_Of_Parameter (WN *expr)
00170  *
00171  * Return the ty for a whirl expression , accounting for the 
00172  * SCLASS_FORMAL_REF lie (in the context in which this routine is called
00173  * the formal ref will eventually be dereferenced)
00174  *
00175  * ====================================================================
00176  */
00177 TY_IDX
00178 TY_Of_Parameter (WN *expr)
00179 {
00180     TY_IDX type;
00181 
00182     type = TY_Of_Expr (expr);
00183 
00184     if ((WN_has_sym(expr))) {
00185   if (WN_sclass(expr) == SCLASS_FORMAL_REF)
00186       return Make_Pointer_Type(type);
00187     }
00188 
00189     return type;
00190 }
00191 
00192 
00193 /* ====================================================================
00194  *
00195  * Is_Float_Type / Is_Float_Node
00196  *
00197  * Determine whether the given type (the type of the object represented
00198  * by the given tree node) is a floating point type.  For this purpose,
00199  * the Fortran complex types are considered floating point.
00200  *
00201  * ====================================================================
00202  */
00203 
00204 BOOL
00205 Is_Float_Type ( TY_IDX ty )
00206 {
00207     TYPE_ID tid;
00208 
00209     /* Determine whether it's floating point: */
00210     switch (TY_kind (ty)) {
00211     case KIND_SCALAR:
00212   tid = TY_mtype (ty);
00213   if (tid > 0 && tid <= MTYPE_LAST)
00214       return MTYPE_float(tid);
00215   break;
00216 
00217     }
00218     return FALSE;
00219 }
00220 
00221 
00222 #ifndef MONGOOSE_BE
00223 /* ====================================================================
00224  *
00225  * Similar_BE_Types
00226  *
00227  * Routine to compare two types. This routine should be called to
00228  * determine whether two TY records are equivalent from a back end
00229  * implementation point of view, i.e. whether they have the same bit
00230  * representation (TY_mtype).  It ignores diffences of volatile and
00231  * const qualifiers. 
00232  *
00233  * WARNING:  This routine is currently used to decide whether a
00234  * field/member is of an appropriate type for use in struct/class
00235  * decomposition for parameter passing in registers.  It is therefore
00236  * irrelevant how it behaves except for scalar and pointer types.  If
00237  * other users are identified, those cases can be modified as
00238  * appropriate for the new users.
00239  *
00240  * ====================================================================
00241  */
00242 
00243 BOOL
00244 Similar_BE_Types ( TY_IDX t1_idx, TY_IDX t2_idx )
00245 {
00246   /* Do a quick check for identical types: */
00247   if ( t1_idx == t2_idx )
00248     return TRUE;
00249 
00250   TY& t1 = Ty_Table [t1_idx];
00251   TY& t2 = Ty_Table [t2_idx];
00252 
00253   /* Insist on valid kinds: */
00254   if ( TY_kind(t1) == 0 || TY_kind(t2) == 0 )
00255     return FALSE;
00256   
00257   switch (TY_kind(t1)) {
00258 
00259     case KIND_SCALAR:
00260     case KIND_POINTER:
00261       return TY_mtype(t1) == TY_mtype(t2) &&
00262        TY_size(t1) == TY_size(t2);
00263 
00264     default:
00265       return FALSE;
00266   }
00267 }
00268 #endif /* MONGOOSE_BE */
00269 
00270 /* ====================================================================
00271  *
00272  * Equivalent_Types
00273  *
00274  * Routine to compare two types. This routine should be called to
00275  * determine whether two TY records are equivalent.
00276  * 
00277  * There are several cases where comparing TY pointers directly
00278  * can yield FALSE even though the types are the same for purposes
00279  * of assignment or comparison.  Using Equivalent_Types to compare
00280  * two types deals with all these cases.
00281  *
00282  *   1) If two types have the same machine representation (be type)
00283  *  except that one is volatile, const or restrict qualified and
00284  *  the other is not.  Such differences between types should
00285  *  usually be ignored by the back-end.  (QUAL_IGNORE)
00286  *
00287  *   2) If two types have the same machine representation (be type)
00288  *  but differ in the volatile, const and/or restrict qualifiers
00289  *  AND this difference is significant to the back-end.
00290  *  (QUAL_CONSIDER)
00291  *
00292  *   3) To the front-ends, there are more qualifiers which are important
00293  *  to determining type equivalency.  Only if these and the volatile,
00294  *  const and restrict qualifiers are identical can the two types be
00295  *  considered equivalent.  (QUAL_FULL)
00296  *
00297  * ====================================================================
00298  */
00299 
00300 
00301 BOOL
00302 Equivalent_Types (TY_IDX t1, TY_IDX t2, QUAL_CHECK consider_qualifiers)
00303 {
00304 
00305     /* Quick check for identical types: */
00306     if ( t1 == t2 )
00307   return TRUE;
00308 
00309     const TY& ty1 = Ty_Table[t1];
00310     const TY& ty2 = Ty_Table[t2];
00311 
00312     /* Insist on identical, valid, TY_kinds: */
00313     if (TY_kind (ty1) != TY_kind (ty2) || TY_kind (ty1) == KIND_INVALID)
00314   return FALSE;
00315     
00316     BOOL match_q =
00317   (consider_qualifiers == QUAL_IGNORE ||
00318    ((TY_is_volatile (t1) == TY_is_volatile (t2) &&
00319      TY_is_const (t1) == TY_is_const (t2) &&
00320      TY_is_restrict (t1) == TY_is_restrict (t2)) &&
00321     (consider_qualifiers != QUAL_FULL ||
00322      (TY_align_exp (t1) == TY_align_exp (t2) &&
00323       TY_is_character(ty1)==TY_is_character(ty2) &&
00324       TY_is_logical(ty1)==TY_is_logical(ty2)))));
00325 
00326     switch ( TY_kind (ty1)) {
00327 
00328     case KIND_VOID:
00329   return match_q;
00330 
00331     case KIND_SCALAR:
00332   return (TY_mtype (ty1) == TY_mtype (ty2) &&
00333     TY_size (ty1) == TY_size (ty2) &&
00334     match_q);
00335     
00336     case KIND_POINTER:
00337   return match_q && Equivalent_Types (TY_pointed (ty1),
00338               TY_pointed (ty2),
00339               consider_qualifiers);
00340 
00341     case KIND_FUNCTION:
00342   return match_q && Equivalent_Types (Tylist_Table[TY_tylist (ty1)],
00343               Tylist_Table[TY_tylist (ty2)],
00344               consider_qualifiers);
00345 
00346     case KIND_ARRAY:
00347          return (match_q && 
00348                  Equivalent_Types (TY_etype (ty1), TY_etype (ty2),
00349                                    consider_qualifiers) &&
00350                  ARB_are_equivalent(TY_arb(ty1), TY_arb(ty2)));
00351 
00352     case KIND_STRUCT:
00353 #ifdef KEY
00354   match_q = (TY_return_in_mem (t1) == TY_return_in_mem (t2) &&
00355        TY_copy_constructor (t1) == TY_copy_constructor (t2) &&
00356        match_q);
00357 #endif
00358   return TY_fld (ty1) == TY_fld (ty2) && match_q;
00359 
00360     default:
00361   ErrMsg ( EC_Invalid_Case, "Equivalent_Types", __LINE__ );
00362   return FALSE;  /* not needed but silences return w/o value warnings */
00363     }
00364 } // Equivalent_Types
00365 
00366 
00367 #ifndef MONGOOSE_BE
00368 #endif /* MONGOOSE_BE */
00369