Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
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 */