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-Oct-94 - Original Version 00042 * 00043 * Description: 00044 * 00045 * See st2c.h for a description of the exported functions and 00046 * variables. This module translates ST nodes into variable and 00047 * function declarations (ST2C_decl_translate), and gets the 00048 * lvalue for a variable or function when directly referenced in 00049 * an expression (ST2C_use_translate). We provide a special 00050 * interface to deal with pseudo registers (pregs), but some 00051 * symbols must be handled by the context in which they appear, 00052 * since this context uniquely determines the reference (e.g. 00053 * labels has label-numbers in the WN tree). 00054 * 00055 * Possibly necessary TODO: sym_consts are only partially 00056 * supported at the moment. 00057 00058 * It is crucial that names with external linkage are generated 00059 * with the same name between compilation units. For this reason 00060 * we give file-scope variables precedence in name-ownership (i.e. 00061 * they are entered first into the symbol-table). If, despite this 00062 * effort, there are clashes between names with static and external 00063 * linkage, the generated code may not be compilable or correctly 00064 * executable. TODO: Emit warning about this. 00065 * 00066 * ==================================================================== 00067 * ==================================================================== 00068 */ 00069 #ifdef _KEEP_RCS_ID 00070 #endif /* _KEEP_RCS_ID */ 00071 00072 #include "whirl2c_common.h" 00073 #include "PUinfo.h" 00074 #include "tcon2c.h" 00075 #include "st2c.h" 00076 #include "ty2c.h" 00077 #include "init2c.h" 00078 #include "unparse_target.h" 00079 00080 00081 /*--------- General purpose macros to get ST attributes ---------------*/ 00082 /*---------------------------------------------------------------------*/ 00083 00084 00085 /* Two common block types are compatible when they are identical, 00086 * excluding qualifiers, but differentiating between differing 00087 * scalars and pointers. 00088 */ 00089 #define ST2C_COMPATIBLE_COMMON_BLOCK_TYPES(ty1, ty2) \ 00090 Stab_Identical_Types(ty1, ty2, FALSE, TRUE, FALSE) 00091 00092 00093 /*------- Handlers for references to and declarations of symbols ------*/ 00094 /*---------------------------------------------------------------------*/ 00095 00096 static void ST2C_ignore(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00097 00098 static void ST2C_decl_error(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00099 static void ST2C_decl_var(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00100 static void ST2C_decl_func(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00101 static void ST2C_decl_const(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00102 00103 static void ST2C_use_error(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00104 static void ST2C_use_var(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00105 static void ST2C_use_func(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00106 static void ST2C_use_const(TOKEN_BUFFER tokens, const ST *st, CONTEXT context); 00107 00108 00109 /* The following maps every ST class to a function that can translate 00110 * it to C. 00111 */ 00112 typedef void (*ST2C_HANDLER_FUNC)(TOKEN_BUFFER, const ST*, CONTEXT); 00113 00114 static const ST2C_HANDLER_FUNC ST2C_Decl_Handle[CLASS_COUNT] = 00115 { 00116 &ST2C_ignore, /* CLASS_UNK == 0x00 */ 00117 &ST2C_decl_var, /* CLASS_VAR == 0x01 */ 00118 &ST2C_decl_func, /* CLASS_FUNC == 0x02 */ 00119 &ST2C_decl_const, /* CLASS_CONST == 0x03 */ 00120 &ST2C_decl_error, /* CLASS_PREG == 0x04 */ 00121 &ST2C_decl_error, /* CLASS_BLOCK == 0x05 */ 00122 &ST2C_decl_error /* CLASS_NAME == 0x06 */ 00123 }; /* ST2C_Decl_Handle */ 00124 00125 static const ST2C_HANDLER_FUNC ST2C_Use_Handle[CLASS_COUNT] = 00126 { 00127 &ST2C_ignore, /* CLASS_UNK == 0x00 */ 00128 &ST2C_use_var, /* CLASS_VAR == 0x01 */ 00129 &ST2C_use_func, /* CLASS_FUNC == 0x02 */ 00130 &ST2C_use_const, /* CLASS_CONST == 0x03 */ 00131 &ST2C_use_error, /* CLASS_PREG == 0x04 */ 00132 &ST2C_decl_error, /* CLASS_BLOCK == 0x05 */ 00133 &ST2C_decl_error /* CLASS_NAME == 0x06 */ 00134 }; /* ST2C_Use_Handle */ 00135 00136 00137 /*----- Utilities for combining Fortran common blocks into unions ----- 00138 * 00139 * We use a hash-table with linked-list buckets to maintain information 00140 * about the common-blocks encountered for a compilation unit. This 00141 * should be freed up when ST2C_finalize() is called, but never before 00142 * then. Note that we allocate batches of TYLIST items at a time. 00143 * 00144 * This implementation of common-block handling when translating from 00145 * Fortran to C circumvents the w2cf_symtab.h symbol naming, instead 00146 * employing its own naming scheme. It seemed simpler that way. 00147 *---------------------------------------------------------------------*/ 00148 00149 #define COMMON_BLOCK_MEMBER_NAME(num) \ 00150 Concat2_Strings("u", Number_as_String(num, "%lld")) 00151 00152 typedef struct Ty2c_List TY2C_LIST; 00153 struct Ty2c_List 00154 { 00155 SYMTAB_IDX symtab_id; /* Current_Symtab->id */ 00156 TOKEN_BUFFER tokens; /* Block declaration, preceded by newline */ 00157 TY_IDX common_ty; /* Not live across PUs */ 00158 TY2C_LIST *next; 00159 }; 00160 #define TY2C_LIST_symtab_id(l) ((l)->symtab_id) 00161 #define TY2C_LIST_tokens(l) ((l)->tokens) 00162 #define TY2C_LIST_common_ty(l) ((l)->common_ty) 00163 #define TY2C_LIST_next(l) ((l)->next) 00164 00165 typedef struct Common_Block COMMON_BLOCK; 00166 struct Common_Block 00167 { 00168 const char *name; /* Name of common block, as given by STs */ 00169 UINT64 hash_value; /* The hash-value for the name */ 00170 TOKEN_BUFFER initializer; /* Initialization */ 00171 TY2C_LIST *initialized; /* An initialized member of the tylist */ 00172 TY2C_LIST *variations; /* The variations in declaration of the block */ 00173 TY2C_LIST *last_variation; /* Last of the variations */ 00174 COMMON_BLOCK *next; /* The next common block in this bucket */ 00175 }; 00176 #define COMMON_BLOCK_name(cb) (cb)->name 00177 #define COMMON_BLOCK_hash_value(cb) (cb)->hash_value 00178 #define COMMON_BLOCK_initializer(cb) (cb)->initializer 00179 #define COMMON_BLOCK_initialized(cb) (cb)->initialized 00180 #define COMMON_BLOCK_variations(cb) (cb)->variations 00181 #define COMMON_BLOCK_last_variation(cb) (cb)->last_variation 00182 #define COMMON_BLOCK_next(cb) (cb)->next 00183 00184 #define COMMON_BLOCK_HASH_TABLE_SIZE 373 00185 static COMMON_BLOCK *Common_Block_Hash_Tbl[COMMON_BLOCK_HASH_TABLE_SIZE]; 00186 00187 00188 #define TY2C_LIST_BLOCK_SIZE 16 00189 typedef struct Ty2c_List_Block TY2C_LIST_BLOCK; 00190 struct Ty2c_List_Block 00191 { 00192 TY2C_LIST element[TY2C_LIST_BLOCK_SIZE]; 00193 TY2C_LIST_BLOCK *next; 00194 }; 00195 #define TY2C_LIST_BLOCK_element(tb, n) &(tb)->element[n] 00196 #define TY2C_LIST_BLOCK_next(tb) (tb)->next 00197 00198 static TY2C_LIST_BLOCK *ST2C_Ty2c_List_Blocks = NULL; /* All alloced Blocks */ 00199 static TY2C_LIST *ST2C_Free_Ty2c_Lists = NULL; /* Unused tylists */ 00200 00201 00202 static BOOL 00203 In_Visible_Symtab(SYMTAB_IDX symtab, SYMTAB_IDX id) 00204 { 00205 SYMTAB_IDX tab; 00206 00207 for (tab = symtab; tab != 0 && tab != id; tab--); 00208 return tab != 0; 00209 } /* In_Visible_Symtab */ 00210 00211 00212 static COMMON_BLOCK * 00213 ST2C_Find_Common_Block(const char *name, UINT64 hash_value) 00214 { 00215 /* Find a common block matching the given name and hash-value, 00216 * returning NULL if no match is found. 00217 */ 00218 COMMON_BLOCK *common; 00219 const UINT32 hash_idx = Name_Hash_Idx(hash_value, 00220 COMMON_BLOCK_HASH_TABLE_SIZE); 00221 Is_True((name != NULL && *name != '\0'), 00222 ("Expected non-empty name in ST2C_Find_Common_Block()")); 00223 00224 for (common = Common_Block_Hash_Tbl[hash_idx]; 00225 (common != NULL && 00226 (COMMON_BLOCK_hash_value(common) != hash_value || 00227 strcmp(COMMON_BLOCK_name(common), name) != 0)); 00228 common = COMMON_BLOCK_next(common)); 00229 00230 return common; 00231 } /* ST2C_Find_Common_Block */ 00232 00233 00234 static COMMON_BLOCK * 00235 ST2C_Get_Common_Block(const char *name, UINT64 hash_value) 00236 { 00237 /* Return a COMMON_BLOCK for the given name and hash_value. Create 00238 * a new common block if none with the given name exists. 00239 */ 00240 COMMON_BLOCK *common; 00241 const UINT32 hash_idx = Name_Hash_Idx(hash_value, 00242 COMMON_BLOCK_HASH_TABLE_SIZE); 00243 00244 common = ST2C_Find_Common_Block(name, hash_value); 00245 if (common == NULL) 00246 { 00247 /* Add a new common block to the beginning of the hash bucket */ 00248 common = TYPE_ALLOC_N(COMMON_BLOCK, 1); 00249 COMMON_BLOCK_name(common) = 00250 strcpy(TYPE_ALLOC_N(char, strlen(name)+1), name); 00251 COMMON_BLOCK_hash_value(common) = hash_value; 00252 COMMON_BLOCK_initializer(common) = NULL; 00253 COMMON_BLOCK_initialized(common) = NULL; 00254 COMMON_BLOCK_variations(common) = NULL; 00255 COMMON_BLOCK_last_variation(common) = NULL; 00256 COMMON_BLOCK_next(common) = Common_Block_Hash_Tbl[hash_idx]; 00257 Common_Block_Hash_Tbl[hash_idx] = common; 00258 } 00259 return common; 00260 } /* ST2C_Get_Common_Block */ 00261 00262 00263 static TY2C_LIST * 00264 ST2C_Get_Common_Ty2c_List(COMMON_BLOCK *common, 00265 mUINT32 symtab_id, 00266 const ST *common_st, 00267 TY_IDX ty) 00268 { 00269 /* Return the TY2C_LIST in the given common block, which is 00270 * compatible with the given ty and the symtab_id. Create a new one 00271 * and add it to the end of the ty2c list if none is found, updating 00272 * the given common block accordingly. 00273 */ 00274 INT ty2c_pos; 00275 TY2C_LIST *ty2c_list; 00276 TY2C_LIST_BLOCK *ty2c_list_block; 00277 00278 if (ST2C_Free_Ty2c_Lists == NULL) 00279 { 00280 /* Our repository of tylists is empty, so replenish it */ 00281 ty2c_list_block = TYPE_ALLOC_N(TY2C_LIST_BLOCK, 1); 00282 TY2C_LIST_BLOCK_next(ty2c_list_block) = ST2C_Ty2c_List_Blocks; 00283 ST2C_Ty2c_List_Blocks = ty2c_list_block; 00284 00285 ST2C_Free_Ty2c_Lists = 00286 TY2C_LIST_BLOCK_element(ST2C_Ty2c_List_Blocks, 0); 00287 for (ty2c_pos = 1; ty2c_pos < TY2C_LIST_BLOCK_SIZE; ty2c_pos++) 00288 TY2C_LIST_next(&ST2C_Free_Ty2c_Lists[ty2c_pos-1]) = 00289 &ST2C_Free_Ty2c_Lists[ty2c_pos]; 00290 TY2C_LIST_next(&ST2C_Free_Ty2c_Lists[TY2C_LIST_BLOCK_SIZE-1]) = NULL; 00291 } 00292 00293 /* See if we already have a type in this common block which is 00294 * compatible with the new given type. 00295 */ 00296 for (ty2c_list = COMMON_BLOCK_variations(common); 00297 (ty2c_list != NULL && 00298 !(In_Visible_Symtab(CURRENT_SYMTAB, TY2C_LIST_symtab_id(ty2c_list)) && 00299 ST2C_COMPATIBLE_COMMON_BLOCK_TYPES(TY2C_LIST_common_ty(ty2c_list), 00300 ty))); 00301 ty2c_list = TY2C_LIST_next(ty2c_list)); 00302 00303 if (ty2c_list == NULL) 00304 { 00305 /* No existing TY in this block is compatible with the new 00306 * type, so add it in the form of a new TY2C_LIST and update 00307 * the given common block accordingly. 00308 */ 00309 CONTEXT context = INIT_CONTEXT; 00310 UINT indentation; 00311 00312 ty2c_list = ST2C_Free_Ty2c_Lists; 00313 ST2C_Free_Ty2c_Lists = TY2C_LIST_next(ST2C_Free_Ty2c_Lists); 00314 00315 TY2C_LIST_symtab_id(ty2c_list) = symtab_id; 00316 TY2C_LIST_common_ty(ty2c_list) = ty; 00317 TY2C_LIST_next(ty2c_list) = NULL; 00318 00319 indentation = Current_Indentation(); 00320 Set_Current_Indentation(0); 00321 Increment_Indentation(); /* One of many common block variations */ 00322 TY2C_LIST_tokens(ty2c_list) = New_Token_Buffer(); 00323 Reset_TY_is_translated_to_c(ty); 00324 STR_IDX name_idx = TY_name_idx(Ty_Table[ty]); 00325 //WTH is this for??? 00326 //Set_TY_name_idx(Ty_Table[ty], 0); 00327 TY2C_translate(TY2C_LIST_tokens(ty2c_list), ty, context); 00328 00329 //add "global struct" variable name output here----fzhao 00330 Append_Token_String(TY2C_LIST_tokens(ty2c_list),ST_name(common_st)); 00331 00332 //Set_TY_name_idx(Ty_Table[ty], name_idx); 00333 Set_TY_is_translated_to_c(ty); 00334 Set_Current_Indentation(indentation); 00335 00336 if (COMMON_BLOCK_variations(common) == NULL) 00337 { 00338 COMMON_BLOCK_variations(common) = ty2c_list; 00339 COMMON_BLOCK_last_variation(common) = ty2c_list; 00340 } 00341 else 00342 { 00343 TY2C_LIST_next(COMMON_BLOCK_last_variation(common)) = ty2c_list; 00344 } 00345 if (ST_is_initialized(common_st)) 00346 { 00347 INITO_IDX inito = Find_INITO_For_Symbol(common_st); 00348 00349 if (inito != 0 && ty != shared_ptr_idx && ty != pshared_ptr_idx) 00350 { 00351 Is_True(!COMMON_BLOCK_initialized(common), 00352 ("Common block (%s) is initialized twice", 00353 ST_name(common_st))); 00354 00355 COMMON_BLOCK_initialized(common) = ty2c_list; 00356 COMMON_BLOCK_initializer(common) = New_Token_Buffer(); 00357 inito = Find_INITO_For_Symbol(common_st); 00358 Append_Token_Special(COMMON_BLOCK_initializer(common), '='); 00359 INITO2C_translate(COMMON_BLOCK_initializer(common), inito); 00360 } 00361 } 00362 } 00363 return ty2c_list; 00364 00365 } /* ST2C_Get_Common_Ty2c_List */ 00366 00367 00368 static void 00369 ST2C_Define_A_Common_Block(TOKEN_BUFFER tokens, 00370 COMMON_BLOCK *common, 00371 CONTEXT context) 00372 { 00373 TOKEN_BUFFER union_tokens; 00374 const char *variation_name; 00375 const char *base_name; 00376 INT ordinal; 00377 TY2C_LIST *ty2c_list; 00378 00379 base_name = WHIRL2C_make_valid_c_name(COMMON_BLOCK_name(common)); 00380 00381 /* Get a declaration for each of the union elements, being careful 00382 * to put the initializing member before any other member. 00383 */ 00384 union_tokens = New_Token_Buffer(); 00385 //Increment_Indentation(); 00386 ordinal = 0; 00387 for (ty2c_list = COMMON_BLOCK_variations(common); 00388 ty2c_list != NULL; 00389 ty2c_list = TY2C_LIST_next(ty2c_list), ordinal++) 00390 { 00391 variation_name = COMMON_BLOCK_MEMBER_NAME(ordinal); 00392 //WEI: WE DON'T WANT TO PUT GLOBAL TYPE DECLS IN A UNION, CODE 00393 //COMMMENTED OUT 00394 00395 if (COMMON_BLOCK_initialized(common) == ty2c_list) 00396 { 00397 //if (ordinal > 0) 00398 // Prepend_Indented_Newline(union_tokens, 1); 00399 //Prepend_Token_String(union_tokens, variation_name); 00400 Prepend_And_Reclaim_Token_List(union_tokens, 00401 &TY2C_LIST_tokens(ty2c_list)); 00402 } 00403 else 00404 { 00405 Append_And_Reclaim_Token_List(union_tokens, 00406 &TY2C_LIST_tokens(ty2c_list)); 00407 //Append_Token_String(union_tokens, variation_name); 00408 // Append_Token_Special(union_tokens, ';'); 00409 //if (TY2C_LIST_next(ty2c_list) != NULL) 00410 // Append_Indented_Newline(union_tokens, 1); 00411 } 00412 } 00413 00414 /* Prepend the union declaration before the members */ 00415 //Prepend_Indented_Newline(union_tokens, 1/*Lines between decls*/); 00416 //Prepend_Token_Special(union_tokens, '{'); 00417 //Prepend_Token_String(union_tokens, base_name); 00418 //Prepend_Token_String(union_tokens, "union"); 00419 //Decrement_Indentation(); 00420 00421 /* Append the union definition after the members */ 00422 //Append_Indented_Newline(union_tokens, 1/*Lines between decls*/); 00423 //Append_Token_Special(union_tokens, '}'); 00424 //Append_Token_String(union_tokens, base_name); 00425 00426 /* Do initialization */ 00427 if (COMMON_BLOCK_initialized(common) != NULL) 00428 { 00429 Append_And_Reclaim_Token_List(union_tokens, 00430 &COMMON_BLOCK_initializer(common)); 00431 } 00432 00433 Append_Token_Special(union_tokens, ';'); 00434 Append_And_Reclaim_Token_List(tokens, &union_tokens); 00435 } /* ST2C_Define_A_Common_Block */ 00436 00437 00438 static const char * 00439 ST2C_Get_Common_Block_Name(const ST *st) 00440 { 00441 const char *base_name; 00442 INT ordinal; 00443 COMMON_BLOCK *common; 00444 TY2C_LIST *ty2c_list; 00445 TY2C_LIST *ty2c_list_iter; 00446 00447 /* Get the basic data */ 00448 common = 00449 ST2C_Get_Common_Block(ST_name(st), Get_Hash_Value_For_Name(ST_name(st))); 00450 ty2c_list = ST2C_Get_Common_Ty2c_List(common, 00451 CURRENT_SYMTAB, 00452 st, ST_type(st)); 00453 base_name = WHIRL2C_make_valid_c_name(COMMON_BLOCK_name(common)); 00454 00455 //WEI: Since we're not putting global type decls in unions anymore, 00456 //name should be identical to the symbol's name(no need to append ".u0") 00457 return base_name; 00458 00459 /* 00460 ordinal = 0; 00461 for (ty2c_list_iter = COMMON_BLOCK_variations(common); 00462 ty2c_list_iter != ty2c_list; 00463 ty2c_list_iter = ty2c_list_iter->next) 00464 { 00465 ordinal++; 00466 } 00467 00468 return Concat3_Strings(base_name, ".", 00469 COMMON_BLOCK_MEMBER_NAME(ordinal)); 00470 */ 00471 } /* ST2C_Get_Common_Block_Name */ 00472 00473 00474 /*---------------- Various hidden utility routines --------------------*/ 00475 /*---------------------------------------------------------------------*/ 00476 00477 static void 00478 ST2C_formal_ref_decl(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00479 { 00480 TOKEN_BUFFER decl_tokens = New_Token_Buffer(); 00481 00482 Is_True(ST_sclass(st) == SCLASS_FORMAL_REF, 00483 ("Unexpected ST_sclass in ST2C_formal_ref_decl()")); 00484 00485 Append_Token_String(decl_tokens, 00486 W2CF_Symtab_Nameof_St(st)); /* name */ 00487 TY2C_translate(decl_tokens, Stab_Pointer_To(ST_type(st)), context); /*type*/ 00488 00489 Append_And_Reclaim_Token_List(tokens, &decl_tokens); 00490 } /* ST2C_formal_ref_decl */ 00491 00492 00493 static void 00494 ST2C_basic_decl(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00495 { 00496 TOKEN_BUFFER decl_tokens = New_Token_Buffer(); 00497 00498 Append_Token_String(decl_tokens, 00499 W2CF_Symtab_Nameof_St(st)); /* name */ 00500 00501 00502 //WEI: 00503 //If type of st is struct, make it incomplete because the complete type will be 00504 //declared in w2c.h (see WN2C_Append_Symtab_Types) 00505 TY_IDX ty = ST_class(st) == CLASS_FUNC ? ST_pu_type(st) : ST_type(st); 00506 if (Compile_Upc) { 00507 if (TY_kind(ty) == KIND_STRUCT || 00508 (TY_kind(ty) == KIND_FUNCTION && 00509 TY_kind(W2X_Unparse_Target->Func_Return_Type(ty)) == KIND_STRUCT)) { 00510 CONTEXT_set_incomplete_ty2c(context); 00511 } 00512 } 00513 00514 TY2C_translate(decl_tokens, 00515 ST_sym_class(st) == CLASS_FUNC ? ST_pu_type(st) : ST_type(st), 00516 context); /* type */ 00517 00518 if (!Stab_No_Linkage(st)) 00519 { 00520 /* Static, common, or extern declarations */ 00521 if (ST_sym_class(st) == CLASS_FUNC && 00522 PU_is_inline_function(Pu_Table[ST_pu(st)])) 00523 { 00524 Prepend_Token_String(decl_tokens, "__inline"); 00525 } else if (ST_sym_class(st) == CLASS_FUNC && 00526 ST_export(st) == EXPORT_LOCAL) { 00527 /* static functions */ 00528 Prepend_Token_String(decl_tokens, "static"); 00529 } else if (ST_sclass(st) == SCLASS_FSTATIC || 00530 ST_sclass(st) == SCLASS_PSTATIC || 00531 ST_sclass(st) == SCLASS_CPLINIT || 00532 ST_sclass(st) == SCLASS_EH_REGION || 00533 ST_sclass(st) == SCLASS_EH_REGION_SUPP || 00534 ST_sclass(st) == SCLASS_DISTR_ARRAY) 00535 { 00536 Prepend_Token_String(decl_tokens, "static"); 00537 } else if (ST_sclass(st) == SCLASS_EXTERN || 00538 ST_sclass(st) == SCLASS_TEXT) 00539 { 00540 Prepend_Token_String(decl_tokens, "extern"); 00541 } 00542 } 00543 00544 Append_And_Reclaim_Token_List(tokens, &decl_tokens); 00545 } /* ST2C_basic_decl */ 00546 00547 00548 static void 00549 ST2C_Define_Preg(const char *name, TY_IDX ty, CONTEXT context) 00550 { 00551 /* Declare a preg of the given type and name as a local 00552 * register variable in the current context. 00553 */ 00554 TOKEN_BUFFER decl_tokens = New_Token_Buffer(); 00555 UINT current_indent = Current_Indentation(); 00556 00557 Set_Current_Indentation(PUinfo_local_decls_indent); 00558 Append_Token_String(decl_tokens, name); 00559 TY2C_translate(decl_tokens, ty, context); 00560 Prepend_Token_String(decl_tokens, "register"); 00561 Append_Token_Special(decl_tokens, ';'); 00562 Append_Indented_Newline(decl_tokens, 1); 00563 Append_And_Reclaim_Token_List(PUinfo_local_decls, &decl_tokens); 00564 Set_Current_Indentation(current_indent); 00565 } /* ST2C_Define_Preg */ 00566 00567 00568 /*----------- hidden routines to handle ST declarations ---------------*/ 00569 /*---------------------------------------------------------------------*/ 00570 00571 static void 00572 ST2C_ignore(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00573 { 00574 return; /* Just ignore it, i.e. do nothing! */ 00575 } /* ST2C_ignore */ 00576 00577 00578 static void 00579 ST2C_decl_error(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00580 { 00581 Is_True(FALSE, 00582 ("ST2C cannot declare this ST_sym_class (%d)", ST_sym_class(st))); 00583 } /* ST2C_decl_error */ 00584 00585 00586 static void 00587 ST2C_decl_var(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00588 { 00589 INITO_IDX inito; 00590 Is_True(ST_sym_class(st)==CLASS_VAR, ("expected CLASS_VAR ST")); 00591 if (ST_is_initialized(st) && !Stab_No_Linkage(st)) /* initialize */ 00592 { 00593 ST2C_basic_decl(tokens, st, context); /*type, name, storage class*/ 00594 inito = Find_INITO_For_Symbol(st); 00595 if (inito != 0) 00596 { 00597 Append_Token_Special(tokens, '='); 00598 INITO2C_translate(tokens, inito); 00599 } 00600 } 00601 else if (ST_sclass(st) == SCLASS_FORMAL_REF) 00602 { 00603 /* This should only occur for Fortran reference parameters 00604 */ 00605 ST2C_formal_ref_decl(tokens, st, context); /*type, name, storage class*/ 00606 } 00607 else 00608 { 00609 /* Ignore the (const) qualifier for automatic and temporary 00610 * variables, since the initialization is done as statements 00611 * for these. 00612 */ 00613 if (ST_sclass(st) == SCLASS_AUTO) 00614 CONTEXT_set_unqualified_ty2c(context); 00615 ST2C_basic_decl(tokens, st, context); /*type, name, storage class*/ 00616 } 00617 } /* ST2C_decl_var */ 00618 00619 00620 static void 00621 ST2C_decl_func(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00622 { 00623 Is_True(ST_sym_class(st)==CLASS_FUNC, ("expected CLASS_FUNC ST")); 00624 00625 /* Note, this is a function declaration, not a definition! */ 00626 ST2C_basic_decl(tokens, st, context); /* type, name and storage class */ 00627 00628 } /* ST2C_decl_func */ 00629 00630 00631 static void 00632 ST2C_decl_const(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00633 { 00634 Is_True(ST_sym_class(st)==CLASS_CONST, ("expected CLASS_CONST ST")); 00635 00636 /* A CLASS_CONST symbol never has a name, and as such don't need to be 00637 * declared! -----fzhao 00638 */ 00639 00640 # if 0 00641 ST2C_basic_decl(tokens, st, context); /* type, name and storage class */ 00642 Append_Token_Special(tokens, '='); 00643 TCON2C_translate(tokens, STC_val(st)); /* value */ 00644 # endif 00645 00646 } /* ST2C_decl_const */ 00647 00648 00649 /*---------------- hidden routines to handle ST uses ------------------*/ 00650 /*---------------------------------------------------------------------*/ 00651 00652 00653 static void 00654 ST2C_use_error(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00655 { 00656 Is_True(FALSE, 00657 ("ST2C cannot use an ST_sym_class (%d)", ST_sym_class(st))); 00658 } /* ST2C_use_error */ 00659 00660 00661 static void 00662 ST2C_use_var(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00663 { 00664 Is_True(ST_sym_class(st)==CLASS_VAR, ("expected CLASS_VAR ST")); 00665 00666 //WEI: when compiling UPC, don't output the initialization expression of DGLOBAL vars 00667 if (Stab_Is_Common_Block(st) && !(Compile_Upc && ST_sclass(st) == SCLASS_DGLOBAL)) 00668 { 00669 /* Do not mark the variable as referenced, since we do not 00670 * want to declare it in the local scope. 00671 */ 00672 00673 Append_Token_String(tokens, ST2C_Get_Common_Block_Name(st)); 00674 00675 } 00676 else 00677 { 00678 Append_Token_String(tokens, W2CF_Symtab_Nameof_St(st)); 00679 /* Mark the variable as referenced, unless it is an external 00680 * defining variable. 00681 */ 00682 if (!Stab_External_Def_Linkage(st)) 00683 Set_BE_ST_w2fc_referenced(st); 00684 } 00685 } /* ST2C_use_var */ 00686 00687 00688 static void 00689 ST2C_use_func(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00690 { 00691 Is_True(ST_sym_class(st)==CLASS_FUNC, ("expected CLASS_FUNC ST")); 00692 Append_Token_String(tokens, W2CF_Symtab_Nameof_St(st)); 00693 if (!Stab_External_Def_Linkage(st)) 00694 Set_BE_ST_w2fc_referenced(st); 00695 } /* ST2C_use_func */ 00696 00697 00698 static void 00699 ST2C_use_const(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00700 { 00701 Is_True(ST_sym_class(st)==CLASS_CONST, ("expected CLASS_CONST ST")); 00702 00703 Append_Token_String(tokens, W2CF_Symtab_Nameof_St(st)); 00704 } /* ST2C_use_const */ 00705 00706 00707 /*------------------------ exported routines --------------------------*/ 00708 /*---------------------------------------------------------------------*/ 00709 00710 00711 void 00712 ST2C_initialize(CONTEXT context) 00713 { 00714 return; /* Do nothing for now */ 00715 } /* ST2C_initialize */ 00716 00717 00718 void 00719 ST2C_finalize(void) 00720 { 00721 INT hash_idx; 00722 COMMON_BLOCK *common; 00723 TY2C_LIST_BLOCK *ty2c_list_block; 00724 void *to_be_freed; 00725 00726 /* Free up the common-block hash table */ 00727 for (hash_idx = 0; hash_idx < COMMON_BLOCK_HASH_TABLE_SIZE; hash_idx++) 00728 { 00729 /* Free up the common-block hash-table bucket */ 00730 common = Common_Block_Hash_Tbl[hash_idx]; 00731 while (common != NULL) 00732 { 00733 to_be_freed = (void *)COMMON_BLOCK_name(common); 00734 FREE(to_be_freed); 00735 to_be_freed = common; 00736 common = COMMON_BLOCK_next(common); 00737 FREE(to_be_freed); 00738 } 00739 Common_Block_Hash_Tbl[hash_idx] = NULL; 00740 } 00741 00742 /* Free up the common-block tylist data structure */ 00743 ty2c_list_block = ST2C_Ty2c_List_Blocks; 00744 while (ty2c_list_block != NULL) 00745 { 00746 to_be_freed = ty2c_list_block; 00747 ty2c_list_block = TY2C_LIST_BLOCK_next(ty2c_list_block); 00748 FREE(to_be_freed); 00749 } 00750 ST2C_Ty2c_List_Blocks = NULL; 00751 00752 } /* ST2C_finalize */ 00753 00754 00755 void 00756 ST2C_decl_translate(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00757 { 00758 ST2C_Decl_Handle[ST_sym_class(st)](tokens, st, context); 00759 } /* ST2C_decl_translate */ 00760 00761 00762 void 00763 ST2C_weakext_translate(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00764 { 00765 Is_True(ST_is_weak_symbol(st), 00766 ("Expected weak symbol in ST2C_weakext_translate()")); 00767 00768 ST2C_decl_translate(tokens, st, context); 00769 Append_Token_Special(tokens, ';'); 00770 Append_Indented_Newline(tokens, 1/*number of lines*/); 00771 Append_Token_String(tokens, "#pragma"); 00772 Append_Token_String(tokens, "weak"); 00773 ST2C_use_translate(tokens, st, context); 00774 00775 if (ST_is_weak_symbol(st) && 00776 Has_Base_Block(st) && 00777 ST_sym_class(ST_base(st)) != CLASS_BLOCK) 00778 { 00779 Append_Token_Special(tokens, '='); 00780 ST2C_use_translate(tokens, ST_strong(st), context); 00781 } 00782 } /* ST2C_weakext_translate */ 00783 00784 00785 void 00786 ST2C_use_translate(TOKEN_BUFFER tokens, const ST *st, CONTEXT context) 00787 { 00788 ST2C_Use_Handle[ST_sym_class(st)](tokens, st, context); 00789 } /* ST2C_use_translate */ 00790 00791 00792 void 00793 ST2C_func_header(TOKEN_BUFFER tokens, 00794 const ST *st, /* ST for function */ 00795 ST **params, /*list of formal parms */ 00796 CONTEXT context) 00797 { 00798 /* Emit the header for a function definition! Note that the resultant 00799 * token buffer will not have appended a newline after the function 00800 * header. 00801 */ 00802 TOKEN_BUFFER header_tokens = New_Token_Buffer(); 00803 INT param, first_param; 00804 TY_IDX funtype = ST_pu_type(st); 00805 BOOL has_prototype = TY_has_prototype(funtype); 00806 00807 Is_True(TY_Is_Function(funtype), 00808 ("Non-function passed to ST2C_func_header")); 00809 Is_True((ST_sclass(st) == SCLASS_TEXT || ST_sclass(st) == SCLASS_EXTERN), 00810 ("Illegal ST_sclass for function")); 00811 00812 /* NOTE: We assume that when we return a value through a parameter, 00813 * the parameter will invariably be the first one. 00814 */ 00815 first_param = (PUINFO_RETURN_TO_PARAM? 1 : 0); 00816 00817 /* Append the function name */ 00818 if (PU_is_mainpu(Pu_Table[ST_pu(st)])) 00819 Append_Token_String(header_tokens, "main"); 00820 else 00821 Append_Token_String(header_tokens, W2CF_Symtab_Nameof_St(st)); 00822 00823 /* Append the parameter list */ 00824 Append_Token_Special(header_tokens, '('); 00825 00826 /* Emit non_prototype parameter names, if necessary */ 00827 if (!has_prototype) 00828 { 00829 for (param = first_param; params[param] != NULL; param++) 00830 { 00831 Append_Token_String(header_tokens, 00832 W2CF_Symtab_Nameof_St(params[param])); 00833 if (params[param+1] != NULL) 00834 Append_Token_Special(header_tokens, ','); 00835 } 00836 Append_Token_Special(header_tokens, ')'); 00837 00838 //WEI: If a struct appears in the function return type, it must be declared as incomplete 00839 if (Compile_Upc) { 00840 CONTEXT_set_incomplete_ty2c(context); 00841 } 00842 TY2C_translate(header_tokens, W2X_Unparse_Target->Func_Return_Type(funtype), context); 00843 00844 /* Emit parameter declarations, indented and on a new line */ 00845 Increment_Indentation(); 00846 for (param = first_param; params[param] != NULL; param++) 00847 { 00848 Append_Indented_Newline(header_tokens, 1); 00849 ST2C_decl_translate(header_tokens, params[param], context); 00850 Append_Token_Special(header_tokens, ';'); 00851 } 00852 Decrement_Indentation(); 00853 } 00854 else // (has_prototype) 00855 { 00856 /* Emit parameter declarations, indented and on a new line */ 00857 TYLIST_IDX param_tylist = TY_parms(funtype); 00858 Increment_Indentation(); 00859 for (param = first_param; params[param] != NULL; param++) 00860 { 00861 Append_Indented_Newline(header_tokens, 1); 00862 if (FALSE/*Turn this off for now*/ && 00863 Tylist_Table[param_tylist] != TY_IDX_ZERO) 00864 { 00865 // Use prototype types, rather than trusting the parameter types. 00866 // 00867 TY_IDX param_ty_idx = ST_type(params[param]); 00868 Set_ST_type(*params[param], Tylist_Table[param_tylist]); 00869 ST2C_decl_translate(header_tokens, params[param], context); 00870 Set_ST_type(*params[param], param_ty_idx); 00871 param_tylist = TYLIST_next(param_tylist); 00872 } 00873 else 00874 { 00875 ST2C_decl_translate(header_tokens, params[param], context); 00876 } 00877 if (params[param+1] != NULL) 00878 Append_Token_Special(header_tokens, ','); 00879 } 00880 00881 /* Finish off the parameter list, with varargs if appropriate */ 00882 if (TY_is_varargs(funtype)) 00883 { 00884 Append_Token_Special(header_tokens, ','); 00885 Append_Token_String(header_tokens, "..."); 00886 } 00887 Append_Token_Special(header_tokens, ')'); 00888 Decrement_Indentation(); 00889 TY2C_translate(header_tokens, W2X_Unparse_Target->Func_Return_Type(funtype), context); 00890 } 00891 00892 if (PU_is_inline_function(Pu_Table[ST_pu(st)])) 00893 Prepend_Token_String(header_tokens, "__inline"); 00894 if (ST_sclass(st) == SCLASS_FSTATIC) 00895 Prepend_Token_String(header_tokens, "static"); 00896 00897 Append_And_Reclaim_Token_List(tokens, &header_tokens); 00898 } /* ST2C_func_header */ 00899 00900 00901 void 00902 ST2C_Use_Preg(TOKEN_BUFFER tokens, 00903 TY_IDX preg_ty, 00904 PREG_IDX preg_idx, 00905 CONTEXT context) 00906 { 00907 /* Append the name of the preg to the token-list and declare the 00908 * preg in the current PU context unless it is already declared. 00909 */ 00910 const char *preg_name; 00911 00912 preg_ty = PUinfo_Preg_Type(preg_ty, preg_idx); 00913 preg_name = W2CF_Symtab_Nameof_Preg(preg_ty, preg_idx); 00914 00915 /* Declare the preg, if it has not already been declared */ 00916 if (!PUinfo_Is_Preg_Declared(preg_ty, preg_idx)) 00917 { 00918 ST2C_Define_Preg(preg_name, preg_ty, context); 00919 PUinfo_Set_Preg_Declared(preg_ty, preg_idx); 00920 } 00921 00922 Append_Token_String(tokens, preg_name); 00923 } /* ST2C_Use_Preg */ 00924 00925 00926 void ST2C_Declare_Tempvar(TY_IDX ty, UINT idx) 00927 { 00928 TOKEN_BUFFER tmp_tokens = New_Token_Buffer(); 00929 UINT current_indent = Current_Indentation(); 00930 CONTEXT ty_context; 00931 00932 Set_Current_Indentation(PUinfo_local_decls_indent); 00933 Append_Token_String( 00934 tmp_tokens, W2CF_Symtab_Nameof_Tempvar(idx)); /* name */ 00935 00936 /* Ignore the (const) qualifier for automatic and temporary 00937 * variables, since the initialization is done as statements 00938 * for these. 00939 */ 00940 CONTEXT_reset(ty_context); 00941 CONTEXT_set_unqualified_ty2c(ty_context); 00942 TY2C_translate(tmp_tokens, ty, ty_context); /* type */ 00943 Append_Token_Special(tmp_tokens, ';'); 00944 Append_Indented_Newline(tmp_tokens, 1); 00945 Append_And_Reclaim_Token_List(PUinfo_local_decls, &tmp_tokens); 00946 Set_Current_Indentation(current_indent); 00947 } /* ST2C_Declare_Tempvar */ 00948 00949 00950 void 00951 ST2C_New_Common_Block(const ST *st) 00952 { 00953 /* Given a Fortran common block st, associate it with the 00954 * corresponding COMMON_BLOCK representation. Note that 00955 * only one common block type may have an initializer 00956 * associated with it. 00957 */ 00958 const char *name = ST_name(st); 00959 const UINT64 hash_value = Get_Hash_Value_For_Name(name); 00960 TY_IDX ty = ST_type(st); 00961 COMMON_BLOCK *common; 00962 00963 Is_True(Stab_Is_Common_Block(st), 00964 ("Expected common block in ST2C_New_Common_Block()")); 00965 00966 /* Create the common block and the associated ty2c list, as defined by 00967 * the given st. 00968 */ 00969 common = ST2C_Get_Common_Block(name, hash_value); 00970 (void)ST2C_Get_Common_Ty2c_List(common, CURRENT_SYMTAB, st, ty); 00971 /* Ensure that the type will not be declared in the local PU scope */ 00972 Set_TY_is_translated_to_c(ty); 00973 } /* ST2C_New_Common_Block */ 00974 00975 00976 void 00977 ST2C_Define_Common_Blocks(TOKEN_BUFFER tokens, CONTEXT context) 00978 { 00979 INT hash_idx; 00980 COMMON_BLOCK *common; 00981 00982 /* Run through the hash-table */ 00983 for (hash_idx = 0; hash_idx < COMMON_BLOCK_HASH_TABLE_SIZE; hash_idx++) 00984 { 00985 /* Run through the list of common blocks */ 00986 for (common = Common_Block_Hash_Tbl[hash_idx]; 00987 common != NULL; 00988 common = COMMON_BLOCK_next(common)) 00989 { 00990 ST2C_Define_A_Common_Block(tokens, common, context); 00991 Append_Indented_Newline(tokens, 2/*Lines between decls*/); 00992 } 00993 } 00994 } /* ST2C_Define_Common_Blocks */ 00995 00996 00997