Open64 (mfef90, whirl2f, and IR tools)  TAG: version-openad; SVN changeset: 916
stab_attr.cxx
Go to the documentation of this file.
00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2 of the GNU General Public License as
00007   published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if 
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU General Public License along
00021   with this program; if not, write the Free Software Foundation, Inc., 59
00022   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 
00024   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025   Mountain View, CA 94043, or:
00026 
00027   http://www.sgi.com
00028 
00029   For further information regarding this notice, see:
00030 
00031   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 
00033 */
00034 
00035 
00036 /* ====================================================================
00037  * ====================================================================
00038  *
00039  *
00040  * Revision history:
00041  *  07-Mar-95 - Original Version
00042  *
00043  * Description:
00044  *
00045  *   Get symbol table (TY and ST) attributes, beyond those provided 
00046  *   through common/com/stab.h.
00047  *
00048  * ====================================================================
00049  * ====================================================================
00050  */
00051 
00052 #ifdef _KEEP_RCS_ID
00053 #endif /* _KEEP_RCS_ID */
00054 
00055 
00056 #include "whirl2c_common.h"
00057 #include "const.h"
00058 #include "PUinfo.h"
00059 #include "cxx_memory.h"
00060 #include "unparse_target.h"
00061 
00062 
00063 BOOL 
00064 Stab_Reserved_Ty(TY_IDX ty)
00065 {
00066    return W2X_Unparse_Target->Builtin_Type(ty) ||
00067           W2X_Unparse_Target->Reserved_Ty_Name(TY_name(ty));
00068 } /* Stab_Reserved_Ty */
00069 
00070 
00071 BOOL 
00072 Stab_Reserved_St(const ST *st)
00073 {
00074    return W2X_Unparse_Target->Reserved_St_Name(ST_name(st));
00075 } /* Stab_Reserved_St */
00076 
00077 
00078 /*------------------- Referenced ST Information ------------------
00079  *----------------------------------------------------------------*/
00080 
00081 
00082 void
00083 Stab_Reset_Referenced_Flag(SYMTAB_IDX symtab)
00084 {
00085    /* Reset the ST_is_referenced() flag for all symbols and constants
00086     * in the given symbol table.  Note that if this is done for the
00087     * global symbol-table for every PU (as I believe is necessary for
00088     * Fortran), we have an O(n^2 + m) algorithm where "n" is the number
00089     * of global symbols and "m" is the number of local PU symbols.
00090     */
00091 
00092    ST_IDX               st_idx;
00093    const ST            *st;
00094 
00095    /* We may need to do this for Fortran, if types may occur at file-scope,
00096     * but it would be wrong to do this for whirl2c where we do not wish
00097     * to redeclare types at file-level.
00098     */
00099    if (W2X_Unparse_Target->Redeclare_File_Types() && symtab == GLOBAL_SYMTAB) {
00100 
00101       for (TY_IDX ty = 1; ty < TY_Table_Size(); ty++)
00102          if (TY_Is_Structured(ty<<8)){
00103             Reset_TY_is_translated_to_c(ty);
00104          }
00105    }
00106 
00107    FOREACH_SYMBOL(symtab, st, st_idx)
00108       Clear_BE_ST_w2fc_referenced(st);
00109 
00110 // it's quicker to clear all flags, but only as long as the
00111 // flags appear for global symtab/ty objects.
00112 
00113    if (symtab == GLOBAL_SYMTAB) 
00114       Clear_w2fc_flags();
00115 
00116 } /* Stab_Reset_Referenced_Flag */
00117 
00118 
00119 //---------------------------------------------------------
00120 //
00121 // Flags for types - just a translated flag now
00122 // assumes no symbols or types added by w2fc are of interest -
00123 // they are ignored.
00124 // 
00125 
00126 enum W2FC_FLAGS
00127 {
00128     W2FC_TY_TRANS  = 0x02     // TY is translated already in PU.
00129 };
00130 
00131 class W2FC_FLAG_ARRAY {
00132 private:
00133   INT32  _size ;
00134   char   *_flags;
00135 
00136   BOOL check_idx(INT32 index) { return (index < _size) ; }  
00137 
00138 public:
00139 
00140   W2FC_FLAG_ARRAY(int sz) 
00141   {
00142     _size  = sz ;
00143     _flags = CXX_NEW_ARRAY(char,sz,Malloc_Mem_Pool);
00144   }
00145 
00146   ~W2FC_FLAG_ARRAY()
00147   {
00148     CXX_DELETE_ARRAY(_flags,Malloc_Mem_Pool);
00149     _size = 0 ; 
00150     _flags = NULL;
00151   }
00152 
00153   void Set_w2fc_flag(INT32 index, enum W2FC_FLAGS flag)
00154   {
00155     if (check_idx(index)) 
00156       _flags[index] |= flag ;
00157   }
00158 
00159   void Reset_w2fc_flag(INT32 index, enum W2FC_FLAGS flag)
00160   { 
00161     if (check_idx(index))
00162       _flags[index] &= ~flag;
00163   }
00164 
00165   BOOL Check_w2fc_flag(INT32 index,enum W2FC_FLAGS flag)
00166   {
00167     BOOL res = FALSE;
00168 
00169     if (check_idx(index))
00170       res = _flags[index] & flag;
00171 
00172     return res;
00173   }
00174 
00175   void Clear_w2fc_flags(void) 
00176   {
00177     if (_flags != NULL) {
00178       memset(_flags, '\0', _size*sizeof(mUINT8)) ;
00179     }
00180   }
00181 };
00182 
00183 // external access,   just for TYs..
00184 
00185 static W2FC_FLAG_ARRAY * W2fc_ty_tab;
00186 
00187 // TY flag functions
00188 
00189 extern void 
00190 Set_TY_is_translated_to_c(const TY_IDX ty) 
00191 {
00192   W2fc_ty_tab->Set_w2fc_flag(TY_IDX_index(ty),W2FC_TY_TRANS) ;
00193 }
00194 
00195 extern void 
00196 Reset_TY_is_translated_to_c(const TY_IDX ty) 
00197 {
00198   W2fc_ty_tab->Reset_w2fc_flag(TY_IDX_index(ty),W2FC_TY_TRANS) ;
00199 } 
00200 
00201 extern BOOL 
00202 TY_is_translated_to_c(const TY_IDX ty) 
00203 {
00204   return (W2fc_ty_tab->Check_w2fc_flag(TY_IDX_index(ty),W2FC_TY_TRANS)) ;
00205 }
00206 
00207 // clear all flags..
00208 
00209 extern void 
00210 Clear_w2fc_flags(void) 
00211 {
00212 //   W2fc_st_tab->Clear_w2fc_flags() ;
00213    W2fc_ty_tab->Clear_w2fc_flags() ;
00214 }
00215 
00216 /*----------------------- Type Information -----------------------*
00217  *----------------------------------------------------------------*/
00218 
00219 
00220 static BOOL
00221 Stab_Compare_Types(TY_IDX t1,
00222                    TY_IDX t2,
00223                    BOOL   check_quals, 
00224                    BOOL   check_pointed_quals,
00225                    BOOL   check_scalars,
00226                    BOOL   ptrs_as_scalars,
00227                    BOOL   assign_t2_to_t1)
00228 {
00229    /* Two types compare if they have the same qualifiers, compatible
00230     * kinds, compatible MTYPEs, and identical substructure.  ENUM
00231     * types are treated as scalars.  While constructed types must
00232     * have identical substructure, we allow more lenient checks for
00233     * the top-level types:  We can turn off qualifier checks 
00234     * (check_quals == FALSE); we can treat all scalar values as 
00235     * identical (check_scalars == FALSE); and we can treat pointers
00236     * as scalars (ptrs_as_scalars == TRUE).
00237     *
00238     * This routine can be adopted to the particular needs of whirl2c,
00239     * and as such is not implemented in terms of Equivalent_Types()
00240     * in common/com/ttype.h.
00241     */
00242   INT i; /* Array dimensions */
00243 
00244   if (t1 == t2)
00245      return TRUE;
00246   else if (TY_kind(t1) == KIND_INVALID || 
00247            TY_kind(t2) == KIND_INVALID ||
00248            (check_quals && !Stab_Identical_Quals(t1, t2)) ||
00249            (check_pointed_quals && 
00250             !Stab_Assign_Compatible_Pointer_Quals(t1, t2)))
00251      return FALSE;
00252   else
00253   {
00254      switch (TY_kind(t1))
00255      {
00256      case KIND_VOID:
00257         return TY_kind(t2) == KIND_VOID; /* Must be identical kinds */
00258 
00259      case KIND_SCALAR:
00260         if (TY_Is_String(t1) && TY_Is_Array_Of_Chars(t2))
00261            return TRUE;
00262         else if (ptrs_as_scalars)
00263            return (TY_Is_Pointer_Or_Scalar(t2) &&
00264                    (!check_scalars || TY_mtype(t1) == TY_mtype(t2)));
00265         else
00266            return (TY_Is_Scalar(t2) &&
00267                    (!check_scalars || TY_mtype(t1) == TY_mtype(t2)));
00268 
00269      case KIND_POINTER:
00270         /* Should we also consider MTYPE_STRING identical to a (char*)? */
00271         if (ptrs_as_scalars)
00272            return (TY_Is_Pointer_Or_Scalar(t2) &&
00273                    (!check_scalars || TY_mtype(t1) == TY_mtype(t2)));
00274         else
00275            return 
00276               (TY_Is_Pointer(t2) &&
00277                (TY_kind(TY_pointed(t1)) == KIND_VOID ||
00278                 TY_kind(TY_pointed(t2)) == KIND_VOID ||
00279                 Stab_Compare_Types(
00280                    TY_pointed(t1), 
00281                    TY_pointed(t2), 
00282                    !assign_t2_to_t1,/* check_quals */
00283                    assign_t2_to_t1,/* check_pointed_quals */
00284                    TRUE,           /* check_scalars */
00285                    FALSE,          /* ptrs_as_scalars */
00286                    FALSE)));       /* assign_t2_to_t1 */
00287 
00288      case KIND_FUNCTION:
00289         /* We do a very quick check to see if two function types are
00290          * identical.  A more elaborate, but slower, method will check
00291          * each individual parameter type (TY_parms(t1) and TY_parms(t2))
00292          * for identity.
00293          */
00294         return (TY_Is_Function(t2)                           &&
00295                 TY_has_prototype(t1) == TY_has_prototype(t2) &&
00296                 TY_is_varargs(t1) == TY_is_varargs(t2)       &&
00297                 TY_parms(t1) == TY_parms(t2)                 &&
00298                 Stab_Compare_Types(W2X_Unparse_Target->Func_Return_Type(t1), 
00299                                    W2X_Unparse_Target->Func_Return_Type(t2),
00300                                    TRUE,  /* check_quals */
00301                                    FALSE, /* check_pointed_quals */
00302                                    TRUE,  /* check_scalars */
00303                                    FALSE, /* ptrs_as_scalars */
00304                                    FALSE) /* assign_t2_to_t1 */
00305                 );
00306 
00307      case KIND_ARRAY:
00308         if (TY_Is_String(t2) && TY_Is_Array_Of_Chars(t1))
00309            return TRUE;
00310         else if (!TY_Is_Array(t2) ||
00311                  TY_AR_ndims(t1) != TY_AR_ndims(t2))
00312            return FALSE;
00313         else
00314         {
00315            for (i=0; i<TY_AR_ndims(t1); i++)
00316            {
00317               /* First check if one constant and the other not;
00318                * then check if constants don't match; we assume
00319                * dynamic bounds/strides always match since we
00320                * implement them in terms of pointers in C.
00321                */
00322               if (TY_AR_const_lbnd(t1,i) != TY_AR_const_lbnd(t2,i) ||
00323                   TY_AR_const_ubnd(t1,i) != TY_AR_const_ubnd(t2,i) ||
00324                   TY_AR_const_stride(t1,i) != TY_AR_const_stride(t2,i))
00325                  return FALSE;
00326               else if (TY_AR_const_lbnd(t1,i) &&
00327                        (TY_AR_lbnd_val(t1,i) != TY_AR_lbnd_val(t2,i)))
00328                  return FALSE;
00329               else if (TY_AR_const_ubnd(t1,i) &&
00330                        (TY_AR_ubnd_val(t1,i) != TY_AR_ubnd_val(t2,i)))
00331                  return FALSE;
00332               else if (TY_AR_const_stride(t1,i) &&
00333                     (TY_AR_stride_val(t1,i) != TY_AR_stride_val(t2,i)))
00334                  return FALSE;
00335            }
00336            return Stab_Compare_Types(TY_AR_etype(t1), 
00337                                      TY_AR_etype(t2),
00338                                      TRUE,   /* check_quals */
00339                                      FALSE,  /* check_pointed_quals */
00340                                      TRUE,   /* check_scalars */
00341                                      FALSE,  /* ptrs_as_scalars */
00342                                      FALSE); /* assign_t2_to_t1 */
00343         }
00344 
00345      case KIND_STRUCT:
00346         return (TY_Is_Structured(t2) &&
00347                 TY_flist(Ty_Table[t1]) == TY_flist(Ty_Table[t2]));
00348 
00349      default:
00350         ErrMsg ( EC_Invalid_Case, "Stab_Compare_Types", __LINE__ );
00351         return FALSE;
00352      }
00353   }
00354 } /* Stab_Compare_Types */
00355 
00356 
00357 BOOL
00358 Stab_Identical_Types(TY_IDX t1,
00359                      TY_IDX t2,
00360                      BOOL   check_quals, 
00361                      BOOL   check_scalars,
00362                      BOOL   ptrs_as_scalars)
00363 {
00364    /* Compare the two types on an equal basis.
00365     */
00366    return 
00367       Stab_Compare_Types(
00368          t1, t2, check_quals, FALSE, check_scalars, ptrs_as_scalars, FALSE);
00369 } /* Stab_Identical_Types */
00370 
00371 
00372 BOOL
00373 Stab_Assignment_Compatible_Types(TY_IDX t1,
00374                                  TY_IDX t2,
00375                                  BOOL   check_quals, 
00376                                  BOOL   check_scalars,
00377                                  BOOL   ptrs_as_scalars)
00378 {
00379    /* Compare the two types for assignment compatibility, assuming
00380     * a value of type t2 will be assigned to a location of type t1.
00381     */
00382    return 
00383       Stab_Compare_Types(
00384          t1, t2, check_quals, FALSE, check_scalars, ptrs_as_scalars, TRUE);
00385 } /* Stab_Stab_Assignment_Compatible_Types */
00386 
00387 
00388 BOOL
00389 Stab_Array_Has_Dynamic_Bounds(TY_IDX ty)
00390 {
00391    INT32 dim;
00392    BOOL is_const = TRUE;
00393    
00394    for (dim = 0; dim < TY_AR_ndims(ty); dim++)
00395    {
00396       is_const = (is_const                  &&
00397                   TY_AR_const_lbnd(ty, dim) &&
00398                   TY_AR_const_ubnd(ty, dim) &&
00399                   TY_AR_const_stride(ty, dim));
00400    }
00401    return !is_const;
00402 } /* Stab_Array_Has_Dynamic_Bounds */
00403 
00404 
00405 BOOL
00406 Stab_Is_Assumed_Sized_Array(TY_IDX ty)
00407 {
00408    BOOL assumed_size = FALSE;
00409 
00410    if (TY_Is_Array(ty))
00411    {
00412       /* Only the last bound may be assumed sized.  Multi-dimensional
00413        * arrays in whirl are represented in row-major order (as in
00414        * C/C++).  Therefore, check the first dimension in the TY which
00415        * is the last Fortran dimension.
00416        */
00417       ARB_HANDLE arb = TY_arb(ty);
00418       
00419       if (ARB_const_lbnd(arb) && 
00420           ARB_const_ubnd(arb) &&
00421           (ARB_ubnd_val(arb) - ARB_lbnd_val(arb) <= 0))
00422       {
00423          assumed_size = TRUE;
00424       }
00425       else if ((!ARB_const_lbnd(arb) && ARB_lbnd_var(arb) == (ST_IDX) 0) ||
00426                (!ARB_const_ubnd(arb) && ARB_ubnd_var(arb) == (ST_IDX) 0))
00427       {
00428          assumed_size = TRUE;
00429       }
00430    }
00431    return assumed_size;
00432 } /* Stab_Is_Assumed_Sized_Array */
00433 
00434 
00435 BOOL 
00436 Stab_Is_Element_Type_Of_Array(TY_IDX atype, TY_IDX etype)
00437 {
00438    if (Stab_Assignment_Compatible_Types(etype, TY_AR_etype(atype), 
00439                                         FALSE, /*check_quals*/
00440                                         TRUE,  /*check_scalars*/
00441                                         FALSE)) /*ptrs_as_scalars*/
00442       return TRUE;
00443    else if (TY_Is_Array(TY_AR_etype(atype)))
00444       return Stab_Is_Element_Type_Of_Array(TY_AR_etype(atype), etype);
00445    else
00446       return FALSE;
00447 } /* Stab_Is_Element_Type_Of_Array */
00448 
00449 
00450 BOOL 
00451 Stab_Is_Equivalenced_Struct(TY_IDX ty)
00452 {
00453    FLD_ITER fld_iter = Make_fld_iter (TY_flist(Ty_Table[ty]));
00454    BOOL is_equivalent_fld = FALSE;
00455 
00456    do {
00457        FLD_HANDLE fld (fld_iter);
00458        is_equivalent_fld = FLD_equivalence (fld);
00459    } while (!FLD_last_field (fld_iter++) && !is_equivalent_fld);
00460        
00461    return is_equivalent_fld;
00462 } /* Stab_Is_Equivalenced_Struct */
00463 
00464 
00465 TY_IDX
00466 Stab_Get_Mload_Ty(TY_IDX base, STAB_OFFSET offset, STAB_OFFSET size)
00467 {
00468    /* Just try to find a field of the given size at the given offset.
00469     * The base should be a struct or union type Return the base
00470     * when it has the desired size or a size of zero (unknown size)
00471     */
00472    TY_IDX ty;
00473    
00474    Is_True(TY_Is_Structured(base),
00475            ("Expected pointer to struct/union type in Stab_Get_Mload_Ty()"));
00476    Is_True(TY_size(base) <= size,
00477            ("Expected struct/union type >= size in Stab_Get_Mload_Ty()"));
00478    
00479    if (TY_size(base) == size ||
00480        (TY_size(base) == 0 && TY_flist(Ty_Table[base]).Is_Null ()))
00481    {
00482       /* End of recursive descent into the structure, so return
00483        * the base type.
00484        */
00485       ty = base;
00486    }
00487    else
00488    {
00489       /* Get the field we wish to access, then apply this algorithm
00490        * recursively.
00491        */
00492       Is_True(!TY_flist(Ty_Table[base]).Is_Null (),
00493               ("Expected non-empty field list in Stab_Get_Mload_Ty()"));
00494       
00495       FLD_HANDLE this_fld = TY_flist(Ty_Table[base]);
00496       FLD_HANDLE next_fld = FLD_next(this_fld);
00497       if (TY_Is_Union(base))
00498       {
00499          /* Search for a struct or union field of the expected size */
00500          while (! next_fld.Is_Null () &&
00501                 (!TY_Is_Structured(FLD_type(this_fld)) ||
00502                  TY_size(FLD_type(this_fld)) < size))
00503          {
00504             this_fld = next_fld;
00505             next_fld = FLD_next(next_fld);
00506          }
00507       }
00508       else /* TY_Is_Struct(TY_pointed(base)) */
00509       {
00510          /* Search for a struct or union field at the expected offset */
00511          while (! next_fld.Is_Null () && FLD_ofst(next_fld) <= offset)
00512          {
00513             this_fld = next_fld;
00514             next_fld = FLD_next(next_fld);
00515          }
00516       }
00517       
00518       Is_True(! this_fld.Is_Null () &&
00519               FLD_ofst(this_fld) <= offset           &&
00520               FLD_ofst(next_fld) >= offset           &&
00521               (TY_Is_Structured(FLD_type(this_fld))) &&
00522               TY_size(FLD_type(this_fld)) >= size, 
00523               ("Could not find a field as expected in Stab_Get_Mload_Ty()"));
00524 
00525       ty = Stab_Get_Mload_Ty(FLD_type(this_fld), 
00526                              offset-FLD_ofst(this_fld),
00527                              size);
00528    }
00529    return ty;
00530 } /* Stab_Get_Mload_Ty */
00531 
00532 
00533 
00534 extern TY_IDX
00535 Stab_Array_Of(TY_IDX etype, mINT64 num_elts)
00536 {
00537   /* Make a 1d array of (pointer?) types. Must handle 0-sized objects */
00538   /* and structs - Make_Array_Type doesn't like structs ...........*/
00539 
00540   TY_IDX  ty_idx;
00541 
00542   ARB_HANDLE arb = New_ARB ();
00543 
00544 //  ARB_Init (arb, 0, num_elts - 1, TY_size(etype));
00545 
00546 /* here,since we keep all arrays lower bound and upper bound     */
00547 /* same with the source files,we have to change this function     */
00548 /* set lower bound is 1 and upper bound is num_elts to consistent */
00549 /*with our source level definition----fzhao                       */
00550 
00551   ARB_Init (arb, 1, num_elts , TY_size(etype));
00552 
00553   Set_ARB_dimension (arb,1);
00554   Set_ARB_last_dimen (arb);
00555   Set_ARB_first_dimen (arb);
00556 
00557   TY& ty = New_TY (ty_idx);
00558   TY_Init (ty, TY_size(etype) * num_elts,KIND_ARRAY, MTYPE_UNKNOWN,0);
00559 
00560   Set_TY_align (ty_idx, TY_size(etype));
00561   Set_TY_etype (ty, etype);
00562   Set_TY_arb (ty, arb);
00563 
00564   return ty_idx;
00565 
00566 }   
00567 
00568 /*-------------------- Global SYMTAB table sizes --------------------
00569  *
00570  * We record the size of certain tables in the global symtab at whirl2c
00571  * initialization.  This information is then used later on in whirl2c
00572  * finialization to reset the tables back to their original size and
00573  * thus undo any additions made to these tables during whirl2c.
00574  *
00575  *--------------------------------------------------------------------*/
00576 
00577 #ifdef W2CF_RESET_SYMTABS
00578 static TY_IDX Orig_Sizeof_Ty_Table;
00579 static FLD_IDX Orig_Sizeof_Fld_Table;
00580 static ARB_IDX Orig_Sizeof_Arb_Table;
00581 static TYLIST_IDX Orig_Sizeof_Tylist_Table;
00582 #endif
00583 
00584 // initalize flags associated with global tables (TY for now).
00585 void 
00586 Stab_initialize_flags(void)
00587 {
00588   W2fc_ty_tab = CXX_NEW(W2FC_FLAG_ARRAY(TY_Table_Size()),Malloc_Mem_Pool);
00589 }
00590 
00591 void 
00592 Stab_finalize_flags(void)
00593 {
00594    CXX_DELETE(W2fc_ty_tab,Malloc_Mem_Pool) ;
00595 }
00596 
00597 void
00598 Stab_initialize(void)
00599 {
00600    /* Record the original size of the Ty_Table, Fld_Table, Arb_Table,
00601       and Tylist_Table - per PU */
00602 
00603 #ifdef W2CF_RESET_SYMTABS
00604    Orig_Sizeof_Ty_Table = TY_Table_Size();
00605    Orig_Sizeof_Fld_Table = FLD_Table_Size();
00606    Orig_Sizeof_Arb_Table = ARB_Table_Size();
00607    Orig_Sizeof_Tylist_Table = TYLIST_Table_Size();
00608 #endif
00609 
00610 } /* Stab_Initialize */
00611 
00612 void
00613 Stab_finalize(void)
00614 {
00615    /* Should ideally reset the Ty_Table, Fld_Table, Arb_Table, 
00616     * Tylist_Table and strtab (?) back to their original size at the 
00617     * start of whirl2c.  This is should also include resetting any 
00618     * references to such deleted symtab entries (e.g. TY_pointed).
00619     * For now we do not do so.
00620     */
00621 #ifdef W2CF_RESET_SYMTABS
00622    INT32 diff;
00623    diff = TY_Table_Size() - Orig_Sizeof_Ty_Table;
00624    if (diff > 0)
00625       (&Ty_Table)->Delete_last(diff);
00626 
00627    diff = FLD_Table_Size() - Orig_Sizeof_Fld_Table;
00628    if (diff > 0)
00629       Fld_Table.Delete_last(diff);
00630    diff = ARB_Table_Size() - Orig_Sizeof_Arb_Table;
00631    if (diff > 0)
00632       Arb_Table.Delete_last(diff);
00633    diff = TYLIST_Table_Size() - Orig_Sizeof_Tylist_Table;
00634    if (diff > 0)
00635       Tylist_Table.Delete_last(diff);
00636 
00637    Verify_SYMTAB (CURRENT_SYMTAB);
00638    Verify_SYMTAB (GLOBAL_SYMTAB);
00639 #endif
00640 
00641 } /* Stab_finalize */
00642 
00643 /*---------------------- Name manipulation -----------------------
00644  *
00645  *    We operate with a cyclic character buffer for identifier names,
00646  *    where the size of the buffer is a minimum of 1024 characters
00647  *    and at a maximum of 8 times the largest name encountered.  Note 
00648  *    that a call to any of the functions described below may allocate
00649  *    a new name buffer.  Name buffers are allocated from the cyclic
00650  *    character buffer, and a name-buffer may be reused at every 8th
00651  *    (MIN_NAME_SLOTS) allocation.  We guarantee that a name-buffer is 
00652  *    valid up until 7 subsequent name-buffer allocations, but no 
00653  *    longer.  After 7 subsequent name-buffer allocations, the name 
00654  *    buffer may be reused (overwritten) or even freed up from dynamic
00655  *    memory.  While the results from the calls to the functions 
00656  *    provided here may be used to construct identifier names, these 
00657  *    results should be saved off into a more permanent buffer area 
00658  *    once the names have been constructed.
00659  *----------------------------------------------------------------*/
00660 
00661 #define MIN_NAME_SLOTS 8
00662 #define MIN_NAME_BUF_SIZE 1024
00663 #define MAX_NUMSTRING_SIZE 128
00664 
00665 static char *Name_Buf;
00666 static UINT Name_Buf_Idx = 0;  /* Next available Name_Buf character */
00667 static UINT Name_Buf_Size = 0; /* Size of Name_Buf */
00668 
00669 static char *buffer_to_be_freed[MIN_NAME_SLOTS];
00670 static UINT  next_delay_slot = 0;
00671 static UINT  delay_count[MIN_NAME_SLOTS] = {0, 0, 0, 0, 0, 0, 0, 0};
00672 static INT   next_to_be_freed = -1;
00673 
00674 
00675 void
00676 Stab_Free_Namebufs(void)
00677 {
00678    /* Called at the end of processing every PU.
00679     */
00680    INT i;
00681    
00682    if (next_to_be_freed > 0)
00683    {
00684       for (i=0; i < MIN_NAME_SLOTS; i++)
00685          if (delay_count[i] > 0)
00686          {
00687             FREE(buffer_to_be_freed[i]);
00688             delay_count[i] = 0;
00689          }
00690       next_to_be_freed = -1;
00691       next_delay_slot = 0;
00692    }
00693    if (Name_Buf_Size > 0)
00694    {
00695       FREE(Name_Buf);
00696       Name_Buf_Idx = Name_Buf_Size = 0;
00697    }
00698 } /* Stab_Free_Namebufs */
00699 
00700 
00701 char * 
00702 Get_Name_Buf_Slot(UINT size)
00703 {
00704    char *name_slot;
00705    
00706    /* See if it is time to free up a buffer */
00707    if (next_to_be_freed >= 0 && 
00708        delay_count[next_to_be_freed] > 0)
00709    {
00710       delay_count[next_to_be_freed]--;
00711       if (delay_count[next_to_be_freed] == 0)
00712       {
00713          FREE(buffer_to_be_freed[next_to_be_freed]);
00714          buffer_to_be_freed[next_to_be_freed] = NULL;
00715          next_to_be_freed = (next_to_be_freed + 1) % MIN_NAME_SLOTS;
00716       }
00717    }
00718    
00719    /* See if we need a larger name-buffer */
00720    if (size*MIN_NAME_SLOTS > Name_Buf_Size)
00721    {
00722       /* (Re)allocate the character buffer */
00723       if (Name_Buf_Size > 0)
00724       {
00725          /* Delay freeing until this function has been called
00726           * MIN_NAME_SLOTS times.
00727           */
00728          buffer_to_be_freed[next_delay_slot] = Name_Buf;
00729          delay_count[next_delay_slot] = MIN_NAME_SLOTS;
00730          next_delay_slot = (next_delay_slot + 1) % MIN_NAME_SLOTS;
00731          
00732          /* Allocate a new buffer */
00733          Name_Buf = TYPE_ALLOC_N(char, size*MIN_NAME_SLOTS);
00734          Name_Buf_Size = size*MIN_NAME_SLOTS;
00735       }
00736       else
00737       {
00738          UINT s = MIN_NAME_BUF_SIZE;
00739 
00740          if (size*MIN_NAME_SLOTS > s) s = size*MIN_NAME_SLOTS;
00741          Name_Buf = TYPE_ALLOC_N(char, s);
00742          Name_Buf_Size = s;
00743       }
00744    }
00745 
00746    /* If the name does not fit in the unused part of the (cyclic)
00747     * buffer, then restart allocation of name slots at the beginning
00748     * of the buffer.
00749     */
00750    if (size + Name_Buf_Idx > Name_Buf_Size)
00751       Name_Buf_Idx = 0;
00752 
00753    /* Allocate a slot for the name within the buffer */
00754    name_slot = &Name_Buf[Name_Buf_Idx];
00755    Name_Buf_Idx += size;
00756 
00757    return name_slot;
00758 } /* Get_Name_Buf_Slot */
00759 
00760 
00761 const char * 
00762 Number_as_String(INT64 number, const char *fmt)
00763 {
00764    char *new_name = Get_Name_Buf_Slot(MAX_NUMSTRING_SIZE);
00765 
00766    sprintf(new_name, fmt, number);
00767    return new_name;
00768 } /* Number_as_String */
00769 
00770 
00771 const char * 
00772 Ptr_as_String(const void *ptr)
00773 {
00774    char *new_name = Get_Name_Buf_Slot(MAX_NUMSTRING_SIZE);
00775    union 
00776    {
00777       const void *ptr;
00778       UINT32      u32;
00779       UINT64      u64;
00780    } ptr_as_number;
00781 
00782    ptr_as_number.ptr = ptr;
00783    
00784    if (sizeof(void *) == sizeof(UINT32))
00785       sprintf(new_name, "%u", ptr_as_number.u32);
00786    else if (sizeof(void *) == sizeof(UINT64))
00787       sprintf(new_name, "%llu", ptr_as_number.u64);
00788    else
00789       Is_True(FALSE, ("Unknown pointer size in Ptr_as_String()"));
00790    
00791    return new_name;
00792 } /* Ptr_as_String */
00793 
00794 
00795 const char *
00796 Concat2_Strings(const char *name1, const char *name2)
00797 {
00798    /* Construct a new name by concatenating two other names.  The
00799     * new name will be put into a new name buffer.
00800     */
00801    INT   name1_length;
00802    INT   name2_length;
00803    char *new_name;
00804    
00805    if (name1 == NULL)
00806       return name2;
00807    else if (name2 == NULL)
00808       return name1;
00809    else if (*name1 == '\0')
00810       return name2;
00811    else if  (*name2 == '\0')
00812       return name1;
00813    else
00814    {
00815       name1_length = strlen(name1);
00816       name2_length = strlen(name2);
00817       new_name = Get_Name_Buf_Slot(name1_length + name2_length + 1);
00818 
00819       (void)strcpy(new_name, name1);
00820       (void)strcpy(&new_name[name1_length], name2);
00821    
00822       return new_name;
00823    }
00824 } /* Concat2_Strings */
00825 
00826 
00827 UINT64
00828 Get_Hash_Value_For_Name(const char *name)
00829 {
00830    /* Assume alpha-numeric characters only differ in the least
00831     * significant 6 bits.  Take only the rightmost characters
00832     * into account.
00833     */
00834    INT64       hash_value = 0;
00835    const char *cptr;
00836 
00837    if (name != NULL) 
00838    {
00839       for (cptr=name; *cptr != '\0'; cptr++)
00840          hash_value = (hash_value << (INT64)6) + (INT64)*cptr;
00841    }  /* if */
00842    if (hash_value < 0)
00843       hash_value = -hash_value;
00844 
00845    return hash_value;
00846 } /* Get_Hash_Value_For_Name */
00847 
00848 
00849 STAB_OFFSET 
00850 Stab_Full_Split_Offset(const ST *split_out_st)
00851 {
00852    const char *name = ST_name(split_out_st);
00853    INT         i;
00854    STAB_OFFSET offset = 0;
00855    UINT64      digit = 1;
00856 
00857    for (i = strlen(name) - 1;
00858         i >= 0 && '0' <= name[i] && '9' >= name[i];
00859         i--)
00860    {
00861       offset += (STAB_OFFSET)(name[i] - '0') * digit;
00862       digit *= 10;
00863    }
00864    return offset;
00865 } /* Stab_Full_Split_Offset */
00866 
00867 
00868 /*------------- Utilities for creating temporary variables ------------
00869  * 
00870  * Maintains an array of TMPVARINFOs, such that a tmpvar can be
00871  * reused whenever the type matches that of an existing tempvar and
00872  * it is not "locked".  The array is indexed by a unique tmpvar
00873  * number.
00874  *---------------------------------------------------------------------*/
00875 
00876 typedef struct TmpVarInfo
00877 {
00878    TY_IDX      ty;
00879    BOOL        locked;
00880 } TMPVARINFO;
00881 
00882 #define TMPVAR_ALLOC_INCREMENTS 32
00883 static TMPVARINFO *TmpVar = NULL;
00884 static INT Next_Tmpvar_Idx = 0;
00885 static INT Max_Tmpvar_Idx = -1;
00886 
00887 
00888 void
00889 Stab_Free_Tmpvars(void)
00890 {
00891    /* Called at the end of processing every PU.
00892     */
00893    if (TmpVar != NULL)
00894    {
00895       FREE(TmpVar);
00896       TmpVar = NULL;
00897       Next_Tmpvar_Idx = 0;
00898       Max_Tmpvar_Idx = -1;
00899    }
00900 } /* Stab_Free_Tmpvars */
00901 
00902 
00903 UINT 
00904 Stab_Lock_Tmpvar(TY_IDX ty, 
00905                  void (*declare_tmpvar)(TY_IDX, UINT))
00906 {
00907    /* Find an available (unlocked) temporary variable of the
00908     * given type, and if none is available, then declare a new
00909     * one.
00910     */
00911    INT idx;
00912    
00913    /* See if we have an available tmpvar of a compatible type */
00914    for (idx = Next_Tmpvar_Idx - 1;
00915         (idx >= 0 &&
00916          (TmpVar[idx].locked ||
00917           !Stab_Identical_Types(TmpVar[idx].ty, ty, FALSE, TRUE, FALSE)));
00918         idx--);
00919    
00920    if (idx < 0)
00921    {
00922       /* Could not find a suitable temporary variable, so declare
00923        * a new one and set "idx" to index this new entry.
00924        */
00925       if (Max_Tmpvar_Idx <= 0)
00926       {
00927          /* Need to allocate the TmpVar array */
00928          TmpVar = TYPE_ALLOC_N(TMPVARINFO, TMPVAR_ALLOC_INCREMENTS);
00929          Max_Tmpvar_Idx = TMPVAR_ALLOC_INCREMENTS;
00930       }
00931       if (Next_Tmpvar_Idx >= Max_Tmpvar_Idx)
00932       {
00933          /* Need to reallocate the TmpVar array */
00934          TmpVar = TYPE_REALLOC_N(TMPVARINFO, 
00935                                  TmpVar, 
00936                                  Next_Tmpvar_Idx,
00937                                  Next_Tmpvar_Idx + TMPVAR_ALLOC_INCREMENTS);
00938          Max_Tmpvar_Idx += TMPVAR_ALLOC_INCREMENTS;
00939       }
00940       idx = Next_Tmpvar_Idx++;
00941       TmpVar[idx].ty = ty;
00942       declare_tmpvar(ty, idx);
00943    }
00944    TmpVar[idx].locked = TRUE;
00945    return idx;
00946 } /* Stab_Lock_Tmpvar */
00947 
00948 
00949 void
00950 Stab_Unlock_Tmpvar(UINT idx)
00951 {
00952    Is_True(idx < Next_Tmpvar_Idx, 
00953            ("Tmpvar index out of range in Stab_Unlock_Tmpvar()"));
00954    
00955    TmpVar[idx].locked = FALSE;
00956 } /* Stab_Unlock_Tmpvar */
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines