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 * 15-June-95 - Original Version 00042 * 00043 * Description: 00044 * 00045 * Translates initializers (INITOs) to Fortran DATA statements. 00046 * Exports the function: 00047 * 00048 * INITO2F_translate() 00049 * 00050 * Note that the function parameter initv_times has two meanings. 00051 * 00052 * When used to get the next initv (this not being padding) it 00053 * indicates how many of the repeat counts we have used up for 00054 * the current initv; when the repeat count is always one (1), 00055 * the initv_idx advances while initv_times remains at zero (0). 00056 * 00057 * When used to skip padding it indicates how much of the next 00058 * padding value has already been accounted for in number of bytes. 00059 * 00060 * This dual meaning is possible since we either are in a padding- 00061 * skipping mode or we are processing non-padding initvs, where 00062 * these modes are exclusive as far as the initv_times counter is 00063 * concerned. Once a complete padding has been skipped, "initv_times" 00064 * should have been set to zero (0), thus having prepared for a 00065 * subsequent call to INIT2F_Next_Initv(). 00066 * 00067 * ==================================================================== 00068 * ==================================================================== 00069 */ 00070 00071 #ifdef _KEEP_RCS_ID 00072 /*REFERENCED*/ 00073 #endif 00074 00075 #include "whirl2f_common.h" 00076 #include "PUinfo.h" 00077 #include "st2f.h" 00078 #include "wn2f.h" 00079 #include "ty2f.h" 00080 #include "tcon2f.h" 00081 #include "init2f.h" 00082 00083 00084 /*------------------- Buffer to hold Data Statements -------------------*/ 00085 /*----------------------------------------------------------------------*/ 00086 00087 /* Is initialized when entering a PU block and reclaimed 00088 * when exiting a PU block. 00089 */ 00090 extern TOKEN_BUFFER Data_Stmt_Tokens; /* Defined in wn2f.c */ 00091 00092 00093 /*--------------------------- Utility Routines -------------------------*/ 00094 /*----------------------------------------------------------------------*/ 00095 00096 00097 #define OFFSET_IS_IN_FLD(fld, ofst) \ 00098 (FLD_ofst(fld) == ofst || \ 00099 (ofst > FLD_ofst(fld) && (ofst - FLD_ofst(fld) < TY_size(FLD_type(fld))))) 00100 00101 00102 static void 00103 Set_Tcon_Value(TCON *tcon, MTYPE mtype, INT typesize, char *bytes) 00104 { 00105 typedef struct Tcon_Value 00106 { 00107 union 00108 { 00109 INT8 i1; 00110 UINT8 u1; 00111 INT16 i2; 00112 UINT16 u2; 00113 INT32 i4; 00114 UINT32 u4; 00115 INT64 i8; 00116 UINT64 u8; 00117 float f[2]; 00118 double d[2]; 00119 QUAD_TYPE q; 00120 } val1; 00121 union 00122 { 00123 float f; 00124 double d; 00125 QUAD_TYPE q; 00126 } val2; 00127 } TCON_VALUE; 00128 00129 union 00130 { 00131 char byte[sizeof(TCON_VALUE)]; 00132 TCON_VALUE val; 00133 } rep; 00134 INT i; 00135 00136 INT k = 0 ; 00137 00138 if (typesize < 4) 00139 k = 4 - typesize; 00140 00141 for (i = 0; i < typesize ; i++) 00142 rep.byte[i+k] = bytes[i]; 00143 00144 switch (mtype) 00145 { 00146 case MTYPE_I1: 00147 rep.val.val1.i1 = ( rep.val.val1.i1 << 24) >> 24 ; /* sign extend */ 00148 *tcon = Host_To_Targ(mtype, rep.val.val1.i1); 00149 break; 00150 00151 case MTYPE_I2: 00152 rep.val.val1.i2 = ( rep.val.val1.i2 << 16) >> 16 ; 00153 *tcon = Host_To_Targ(mtype, rep.val.val1.i2); 00154 break; 00155 00156 case MTYPE_I4: 00157 *tcon = Host_To_Targ(mtype, rep.val.val1.i4); 00158 break; 00159 00160 case MTYPE_I8: 00161 *tcon = Host_To_Targ(mtype, rep.val.val1.i8); 00162 break; 00163 00164 case MTYPE_U1: 00165 *tcon = Host_To_Targ(mtype, rep.val.val1.u1); 00166 break; 00167 00168 case MTYPE_U2: 00169 *tcon = Host_To_Targ(mtype, rep.val.val1.u2); 00170 break; 00171 00172 case MTYPE_U4: 00173 *tcon = Host_To_Targ(mtype, rep.val.val1.u4); 00174 break; 00175 00176 case MTYPE_U8: 00177 *tcon = Host_To_Targ(mtype, rep.val.val1.u8); 00178 break; 00179 00180 case MTYPE_F4: 00181 /* TODO: export Host_To_Targ_Float_4() from be.so 00182 */ 00183 *tcon = Host_To_Targ_Float(mtype, rep.val.val1.f[0]); 00184 break; 00185 00186 case MTYPE_F8: 00187 *tcon = Host_To_Targ_Float(mtype, rep.val.val1.d[0]); 00188 break; 00189 00190 case MTYPE_FQ: 00191 *tcon = Host_To_Targ_Quad(rep.val.val1.q); 00192 break; 00193 00194 case MTYPE_C4: 00195 *tcon = Host_To_Targ_Complex_4 (mtype,rep.val.val1.f[0],rep.val.val1.f[1]); 00196 break; 00197 00198 case MTYPE_C8: 00199 *tcon = Host_To_Targ_Complex (mtype,rep.val.val1.d[0],rep.val.val1.d[1]); 00200 break; 00201 00202 case MTYPE_CQ: 00203 *tcon = Host_To_Targ_Complex_Quad (rep.val.val1.q,rep.val.val2.q); 00204 break; 00205 00206 default: 00207 ASSERT_DBG_FATAL(FALSE, 00208 (DIAG_W2F_UNEXPECTED_TYPE_KIND, 00209 mtype, "Set_Tcon_Value")); 00210 break; 00211 } 00212 } /* Set_Tcon_Value */ 00213 00214 00215 static void 00216 INIT2F_Prepend_Equivalence(TOKEN_BUFFER tokens, 00217 TOKEN_BUFFER name1_tokens, 00218 UINT tmpvar_idx) 00219 { 00220 /* Generate an equivalence declaration in the "tokens" buffer, 00221 * where a temporary variable is equivalenced to some other 00222 * memory reference. 00223 */ 00224 // Prepend_F77_Indented_Newline(tokens, 1, NULL/*label*/); 00225 Prepend_Token_Special(tokens, ')'); 00226 Prepend_Token_String(tokens, W2CF_Symtab_Nameof_Tempvar(tmpvar_idx)); 00227 Prepend_Token_Special(tokens, ','); 00228 Prepend_And_Copy_Token_List(tokens, name1_tokens); 00229 Prepend_Token_Special(tokens, '('); 00230 Prepend_Token_String(tokens, "EQUIVALENCE"); 00231 Prepend_F77_Indented_Newline(tokens, 1, NULL/*label*/); 00232 } /* INIT2F_Prepend_Equivalence */ 00233 00234 00235 static void 00236 INIT2F_Append_Initializer(TOKEN_BUFFER tokens, 00237 TOKEN_BUFFER *init_tokens, 00238 INT repeat) 00239 { 00240 /* Given the tokens for an initializer value or memory reference, 00241 * indicate a repeat-factor ('*') and preceede this initializer 00242 * with a comma if the "tokens" buffer is non-empty. 00243 */ 00244 if (repeat > 1) 00245 { 00246 Prepend_Token_Special(*init_tokens, '*'); 00247 Prepend_Token_String(*init_tokens, Number_as_String(repeat, "%llu")); 00248 } 00249 if (!Is_Empty_Token_Buffer(tokens)) 00250 Append_Token_Special(tokens, ','); 00251 Append_And_Reclaim_Token_List(tokens, init_tokens); 00252 } /* INIT2F_Append_Initializer */ 00253 00254 static UINT16 00255 INIT2F_choose_repeat(const INITV& initv) 00256 { 00257 UINT16 rep = 0 ; 00258 00259 switch(INITV_kind(initv)) 00260 { 00261 case INITVKIND_ZERO: 00262 case INITVKIND_ONE: 00263 case INITVKIND_VAL: 00264 rep = INITV_repeat2(initv); 00265 break; 00266 00267 default: 00268 rep = INITV_repeat1(initv); 00269 break; 00270 } 00271 00272 return rep ; 00273 } 00274 00275 static void 00276 INIT2F_Next_Initv(const INITV& initv, 00277 UINT *initv_idx, 00278 UINT *initv_times) 00279 { 00280 00281 /* Only use this to get the next initv when the current 00282 * initv is *not* an INITVKIND_PAD. For padding use 00283 * INIT2F_Skip_Padding() instead. 00284 */ 00285 if (*initv_times+1 < INIT2F_choose_repeat(initv)) 00286 { 00287 (*initv_times)++; 00288 } 00289 else 00290 { 00291 *initv_times = 0; 00292 (*initv_idx)++; 00293 } 00294 } /* INIT2F_Append_Initializer */ 00295 00296 static void 00297 INIT2F_Skip_Padding(INITV_IDX *initv_array, 00298 TY_IDX object_ty, /* Padding occurs in this type */ 00299 STAB_OFFSET *ofst, /* offset from object_ty base */ 00300 UINT *initv_idx) /* Index to a padding initv */ 00301 { 00302 /* Note that padding is skipped on a byte-by-byte basis, where 00303 * the bytes skipped are indicated by the pad_used (initv_times) 00304 * variable. 00305 */ 00306 INITV_IDX initv; 00307 00308 for (initv = initv_array[*initv_idx]; 00309 (*ofst < TY_size(object_ty) && 00310 initv != (INITV_IDX) 0 && 00311 INITV_kind(Initv_Table[initv]) == INITVKIND_PAD); 00312 initv = initv_array[++(*initv_idx)]) 00313 { 00314 *ofst += INITV_pad(Initv_Table[initv])*INIT2F_choose_repeat(Initv_Table[initv]); 00315 } 00316 if (*ofst < TY_size(object_ty) && initv == (INITV_IDX) 0) 00317 *ofst = TY_size(object_ty); /* To handle bugs in WHIRL INITV structure */ 00318 } /* INIT2F_Skip_Padding */ 00319 00320 static UINT 00321 INIT2F_Number_Of_Initvs(INITV_IDX initv) 00322 { 00323 UINT count = 0; 00324 UINT64 rep; 00325 00326 while (initv != 0) 00327 { 00328 INITV& ini = Initv_Table[initv]; 00329 00330 if (INITV_kind(ini) == INITVKIND_BLOCK) 00331 { 00332 for (rep = 1; rep <= INIT2F_choose_repeat(ini) ; rep++) 00333 count += INIT2F_Number_Of_Initvs(INITV_blk(ini)); 00334 } 00335 else 00336 count += 1; 00337 00338 initv = INITV_next(initv); 00339 } 00340 return count; 00341 } /* INIT2F_Number_Of_Initvs */ 00342 00343 static void 00344 INIT2F_Collect_Initvs(INITV_IDX *initv_array, UINT *initv_idx, INITV_IDX initv) 00345 { 00346 UINT64 rep; 00347 00348 while (initv != (INITV_IDX) 0) 00349 { 00350 if (INITV_kind(Initv_Table[initv]) == INITVKIND_BLOCK) 00351 for (rep = 1; rep <= INIT2F_choose_repeat(Initv_Table[initv]); rep++) 00352 INIT2F_Collect_Initvs(initv_array, initv_idx, INITV_blk(Initv_Table[initv])); 00353 else 00354 initv_array[(*initv_idx)++] = initv; 00355 00356 initv = INITV_next(initv); 00357 } 00358 } /* INIT2F_Collect_Initvs */ 00359 00360 static INITV_IDX * 00361 INIT2F_Get_Initv_Array(ST *st, INITO_IDX first_inito) 00362 { 00363 /* Allocate an array of INITV_IDXs, and initialize it to hold all 00364 * top-level INITVs applying to the given ST. The array must be 00365 * freed by the caller when it is no longer used. Flatten out 00366 * any nested INITV_blocks. 00367 */ 00368 00369 UINT number_of_initvs = 1; 00370 INITV_IDX *initv_array; 00371 UINT i ; 00372 00373 /* Count the initv's for this object */ 00374 00375 INITO *ini = &Inito_Table[first_inito] ; 00376 00377 FOREACH_INITO(ST_level(st),ini,i) 00378 { 00379 if (INITO_st(ini) == st) 00380 number_of_initvs += INIT2F_Number_Of_Initvs(INITO_val(*ini)); 00381 } 00382 00383 /* Allocate and initialize the initv array for this object */ 00384 00385 initv_array = TYPE_ALLOC_N(INITV_IDX, number_of_initvs); 00386 initv_array[number_of_initvs-1] = (INITV_IDX) 0; /* terminator */ 00387 number_of_initvs = 0; 00388 00389 ini = &Inito_Table[first_inito] ; 00390 00391 FOREACH_INITO(ST_level(st),ini,i) 00392 { 00393 if (INITO_st(ini) == st) 00394 INIT2F_Collect_Initvs(initv_array, &number_of_initvs, INITO_val(*ini)); 00395 } 00396 return initv_array; 00397 00398 } /* INIT2F_Get_Initv_Array */ 00399 00400 /*--------- Routines to organize and handle each kind of INITV ---------* 00401 *----------------------------------------------------------------------*/ 00402 00403 static TY_IDX 00404 INITVKIND_ty(INITV_IDX initv_idx) 00405 { 00406 /* Determine what type of initializer we have. 00407 */ 00408 INITV& initv = Initv_Table[initv_idx] ; 00409 TY_IDX initv_ty; 00410 00411 switch (INITV_kind(initv)) 00412 { 00413 case INITVKIND_VAL: 00414 if (TCON_ty(INITV_tc_val(initv)) == MTYPE_STRING) 00415 { 00416 initv_ty = Stab_Array_Of(Stab_Mtype_To_Ty(MTYPE_U1), 00417 Targ_String_Length(INITV_tc_val(initv))); 00418 Set_TY_is_character(Ty_Table[initv_ty]); 00419 } 00420 else 00421 initv_ty = Stab_Mtype_To_Ty(TCON_ty(INITV_tc_val(initv))); 00422 break; 00423 00424 case INITVKIND_SYMOFF: 00425 00426 /* A pointer type, we have no idea what pointer type if 00427 * the symbol is a structure. 00428 */ 00429 if (TY_Is_Structured(ST_type(INITV_st(initv)))) 00430 initv_ty = Stab_Pointer_To(Void_Type); 00431 else 00432 initv_ty = Stab_Pointer_To(ST_type(INITV_st(initv))); 00433 break; 00434 00435 case INITVKIND_ZERO: 00436 case INITVKIND_ONE: 00437 initv_ty = Be_Type_Tbl(INITV_mtype(initv)); 00438 break; 00439 00440 default: 00441 ASSERT_DBG_FATAL(FALSE, 00442 (DIAG_W2F_UNEXPECTED_INITV, 00443 INITV_kind(initv), "INITVKIND_ty")); 00444 00445 } 00446 00447 return initv_ty; 00448 00449 } /* INITVKIND_ty */ 00450 00451 static void 00452 INITVKIND_symoff(TOKEN_BUFFER tokens, 00453 INT repeat, 00454 ST *st, 00455 STAB_OFFSET ofst, 00456 TY_IDX object_ty) 00457 { 00458 WN2F_CONTEXT context = INIT_WN2F_CONTEXT; 00459 TOKEN_BUFFER symref_tokens = New_Token_Buffer(); 00460 00461 WN2F_Offset_Symref(symref_tokens, 00462 st, 00463 Stab_Pointer_To(ST_type(st)), 00464 object_ty, 00465 ofst, 00466 context); 00467 WN2F_Address_Of(symref_tokens); 00468 INIT2F_Append_Initializer(tokens, &symref_tokens, repeat); 00469 } /* INITVKIND_symoff */ 00470 00471 static void 00472 INITVKIND_val(TOKEN_BUFFER tokens, 00473 INT repeat, 00474 TCON *tcon, 00475 TY_IDX object_ty) 00476 { 00477 /* Translate the constant value and prepend the repeat count. 00478 * TODO: handle logical values correctly. 00479 */ 00480 TOKEN_BUFFER val_tokens = New_Token_Buffer(); 00481 00482 if (TCON_ty(*tcon) == MTYPE_STRING && 00483 !TY_Is_Array(object_ty) && !TY_Is_String(object_ty)) 00484 { 00485 /* Special case to handle some F90 initializers 00486 */ 00487 if (TY_Is_Scalar(object_ty)) 00488 { 00489 char *strbase = Targ_String_Address(*tcon); 00490 INT strlen = Targ_String_Length(*tcon); 00491 INT stridx; 00492 INT repeatcount = 0; 00493 TCON t; 00494 char *valp = (TY_Is_Complex(object_ty)? 00495 (char *)&t.cmplxval : 00496 (char *)&t.vals); 00497 00498 while (repeatcount++ < repeat) 00499 { 00500 stridx = 0; 00501 while (stridx < strlen) 00502 { 00503 Set_Tcon_Value(&t, 00504 TY_mtype(object_ty), 00505 TY_size(object_ty), 00506 &strbase[stridx]); 00507 TCON2F_translate(val_tokens, t, TY_is_logical(Ty_Table[object_ty])); 00508 stridx += TY_size(object_ty); 00509 if (stridx < strlen) 00510 Append_Token_Special(val_tokens, ','); 00511 00512 } 00513 } 00514 } 00515 } 00516 else 00517 { 00518 /* The normal case, where INITVs match the object initialized 00519 */ 00520 TCON2F_translate(val_tokens, *tcon, TY_is_logical(Ty_Table[object_ty]),object_ty); 00521 } 00522 INIT2F_Append_Initializer(tokens, &val_tokens, repeat); 00523 } /* INITVKIND_val */ 00524 00525 00526 /* put out integer one/zero/t/f for initvs */ 00527 00528 static const char * one_consts[6] = { "1", ".TRUE.", "1_1", "1_2" , "1_4", "1_8"} ; 00529 static const char * zero_consts[6] = { "0", ".FALSE.","0_1", "0_2" , "0_4", "0_8"} ; 00530 00531 static void 00532 INITVKIND_const(TOKEN_BUFFER tokens, 00533 INT repeat, 00534 const char** tbl, 00535 TY_IDX ty) 00536 { 00537 const char *p = tbl[0]; 00538 00539 TOKEN_BUFFER val_tokens = New_Token_Buffer(); 00540 00541 if (TY_is_logical(Ty_Table[ty])) 00542 p = tbl[1]; 00543 else { 00544 00545 if (WN2F_F90_pu) { 00546 switch (TY_mtype(ty)) { 00547 case MTYPE_I1: p = tbl[2]; break; 00548 case MTYPE_I2: p = tbl[3]; break; 00549 case MTYPE_I4: p = tbl[4]; break; 00550 case MTYPE_I8: p = tbl[5]; break; 00551 } 00552 } 00553 } 00554 Append_Token_String(val_tokens,p); 00555 INIT2F_Append_Initializer(tokens, &val_tokens, repeat); 00556 } 00557 00558 00559 static void 00560 INITVKIND_translate(TOKEN_BUFFER tokens, 00561 INITV_IDX initv_idx, 00562 TY_IDX object_ty, 00563 UINT repeat) 00564 { 00565 INITV& initv = Initv_Table[initv_idx]; 00566 00567 switch (INITV_kind(initv)) 00568 { 00569 case INITVKIND_SYMOFF: 00570 INITVKIND_symoff(tokens, 00571 repeat, 00572 &St_Table[INITV_st(initv)], 00573 INITV_ofst(initv), 00574 object_ty); 00575 break; 00576 00577 case INITVKIND_VAL: 00578 INITVKIND_val(tokens, repeat, &Tcon_Table[INITV_tc(initv)], object_ty); 00579 break; 00580 00581 case INITVKIND_ONE: 00582 INITVKIND_const(tokens, repeat, one_consts, object_ty); 00583 break; 00584 00585 case INITVKIND_ZERO: 00586 INITVKIND_const(tokens, repeat, zero_consts, object_ty); 00587 break; 00588 00589 default: 00590 ASSERT_DBG_WARN(FALSE, (DIAG_W2F_UNEXPECTED_INITV, 00591 INITV_kind(initv), "INITV2F_ptr_or_scalar")); 00592 break; 00593 } 00594 } /* INITVKIND_translate */ 00595 00596 /*----------- Utilities for character string initialization ------------* 00597 *----------------------------------------------------------------------*/ 00598 00599 static void 00600 INIT2F_Translate_Char_Ref(TOKEN_BUFFER tokens, /* Append reference here */ 00601 ST *base_object, 00602 TY_IDX array_etype, /* array element type */ 00603 STAB_OFFSET base_ofst, /* ofst to array */ 00604 STAB_OFFSET array_ofst, /* ofst within array */ 00605 STAB_OFFSET string_ofst, /* ofst within string */ 00606 UINT string_size, 00607 WN2F_CONTEXT context) 00608 { 00609 /* Translate a reference to a substring of size "string_size" at 00610 * offset: 00611 * 00612 * base_ofst + array_ofst + string_ofst 00613 * 00614 * within the "base_object". 00615 */ 00616 00617 /* Generate the array indexing expression */ 00618 WN2F_Offset_Symref(tokens, 00619 base_object, 00620 Stab_Pointer_To(ST_type(base_object)), 00621 array_etype, 00622 base_ofst + array_ofst, 00623 context); 00624 00625 /* Generate the substring expression */ 00626 if (string_size != TY_size(array_etype)) 00627 { 00628 Append_Token_Special(tokens, '('); 00629 Append_Token_String(tokens, 00630 Number_as_String(string_ofst+1, "%llu")); 00631 Append_Token_Special(tokens, ':'); 00632 Append_Token_String(tokens, 00633 Number_as_String(string_ofst+string_size, "%llu")); 00634 Append_Token_Special(tokens, ')'); 00635 } 00636 } /* INIT2F_Translate_Char_Ref */ 00637 00638 00639 /*------------------ Utilities for array initialization ----------------* 00640 *----------------------------------------------------------------------*/ 00641 00642 typedef struct Array_Segment 00643 { 00644 INITV_IDX *initv_array; /* Array of initializers */ 00645 BOOL missing_padding; /* Reached unexpected end of initv sequence */ 00646 UINT num_initvs; /* Number of initializing elements */ 00647 UINT first_idx; /* Index of first initializer */ 00648 UINT last_idx; /* Index of last initializer */ 00649 UINT first_repeat; /* Times the first initv should be repeated */ 00650 UINT last_repeat; /* Times the last initv should be repeated */ 00651 STAB_OFFSET start_ofst; /* Offset to start of initialized array segment */ 00652 STAB_OFFSET end_ofst; /* Offset to end of initialized array segment */ 00653 TY_IDX atype; /* Array type */ 00654 TY_IDX etype; /* Array element type */ 00655 } ARRAY_SEGMENT; 00656 00657 00658 static BOOL 00659 INIT2F_is_string_initv(INITV& ini, TY_IDX ty) 00660 { 00661 BOOL res = FALSE; 00662 00663 if (INITV_kind(ini) == INITVKIND_VAL) 00664 { 00665 res = (TCON_ty(INITV_tc_val(ini)) == MTYPE_STRING && 00666 TY_size(ty) > 0 && /* necessary? */ 00667 TY_size(ty) < Targ_String_Length(INITV_tc_val(ini))) ; 00668 00669 } 00670 return res ; 00671 } 00672 00673 static ARRAY_SEGMENT 00674 INIT2F_Get_Array_Segment(INITV_IDX *initv_array, /* in */ 00675 UINT *initv_idx, /* in out*/ 00676 UINT *initv_times, /* in out*/ 00677 TY_IDX object_type, /* in */ 00678 STAB_OFFSET *object_ofst) /* in out*/ 00679 { 00680 /* Get a consecutive sequence of initializers for a consecutive 00681 * sequence of array elements. Note that object_ofst will be 00682 * set to the offset of the initv element following the array 00683 * from the base of the array. Initv_idx and initv_times will 00684 * be updated to point to the initv immediately following the 00685 * array segment. 00686 */ 00687 const UINT first_already_repeated = *initv_times; 00688 STAB_OFFSET max_ofst; 00689 ARRAY_SEGMENT aseg; 00690 INITV_IDX initv; 00691 00692 00693 /* Get the immediately available information */ 00694 aseg.initv_array = initv_array; 00695 aseg.num_initvs = 0; /* To be calculated */ 00696 aseg.first_idx = *initv_idx; 00697 aseg.last_idx = aseg.first_idx; /* To be calculated */ 00698 aseg.start_ofst = *object_ofst; 00699 aseg.atype = object_type; 00700 aseg.etype = TY_AR_etype(object_type); 00701 00702 00703 /* Walk though the initializers until we reach the last initv 00704 * belonging to this array segment. I.e. the in/out parameters 00705 * will be updated to refer to the initializer immediately 00706 * following this array segment, while "repeated" and "idx" 00707 * denote the last initv belonging to this segment. 00708 */ 00709 initv = initv_array[aseg.first_idx]; 00710 max_ofst = TY_size(object_type); 00711 while (max_ofst > *object_ofst && 00712 initv != (INITV_IDX) 0 00713 && INITV_kind(Initv_Table[initv]) != INITVKIND_PAD) 00714 { 00715 00716 INITV& ini = Initv_Table[initv]; 00717 aseg.num_initvs++; 00718 aseg.last_idx = *initv_idx; 00719 aseg.last_repeat = *initv_times+1; 00720 00721 if (INIT2F_is_string_initv(ini,aseg.etype)) 00722 { 00723 /* Special case for F90 - it creates unsigned words for DATA */ 00724 00725 if (!WN2F_F90_pu) 00726 { 00727 ASSERT_DBG_WARN(FALSE, 00728 (DIAG_W2F_UNEXPECTED_INITV, 00729 TCON_ty(INITV_tc_val(ini)), 00730 "[character string exceeds size of element type] " 00731 "INIT2F_Get_Array_Segment")); 00732 } 00733 *object_ofst += Targ_String_Length(INITV_tc_val(ini)); 00734 } 00735 else if (TY_is_character(Ty_Table[aseg.etype]) && 00736 TCON_ty(INITV_tc_val(ini)) == MTYPE_STRING) 00737 { 00738 *object_ofst += Targ_String_Length(INITV_tc_val(ini)); 00739 } 00740 else 00741 *object_ofst += TY_size(aseg.etype); 00742 00743 /* Get the next initv and advance the external idx and times to refer 00744 * to this next initv. 00745 */ 00746 INIT2F_Next_Initv(ini, initv_idx, initv_times); 00747 initv = initv_array[*initv_idx]; 00748 } 00749 00750 if (max_ofst > *object_ofst && initv == (INITV_IDX) 0) 00751 { 00752 aseg.missing_padding = TRUE; 00753 ASSERT_DBG_WARN(FALSE, 00754 (DIAG_W2F_UNEXPEXTED_NULL_PTR, 00755 "initv (missing padding for object initializer?)", 00756 "INIT2F_Get_Array_Segment")); 00757 } 00758 else 00759 aseg.missing_padding = FALSE; 00760 00761 /* Wrap up the array-segment attributes by getting the offset to 00762 * the initv immediately following the segment and the repeat 00763 * factors on the first and last initv in the segment (the other 00764 * initvs being repeated to their full extent). 00765 */ 00766 aseg.end_ofst = *object_ofst; 00767 if (aseg.last_idx > aseg.first_idx) 00768 { 00769 aseg.first_repeat = 00770 INIT2F_choose_repeat(Initv_Table[initv_array[aseg.first_idx]]) - first_already_repeated; 00771 } 00772 else /* aseg.last_idx == aseg.first_idx */ 00773 { 00774 aseg.first_repeat = aseg.last_repeat - first_already_repeated; 00775 aseg.last_repeat = aseg.first_repeat; 00776 } 00777 00778 return aseg; 00779 } /* INIT2F_Get_Array_Segment */ 00780 00781 static void 00782 INIT2F_Translate_Array_Value(TOKEN_BUFFER tokens, 00783 const ARRAY_SEGMENT *aseg) 00784 { 00785 UINT initv_idx, repeat; 00786 INITV_IDX initv; 00787 00788 for (initv_idx = aseg->first_idx; initv_idx <= aseg->last_idx; initv_idx++) 00789 { 00790 /* Get the initv and the repeat factor */ 00791 initv = aseg->initv_array[initv_idx]; 00792 if (initv_idx == aseg->first_idx) 00793 repeat = aseg->first_repeat; 00794 else if (initv_idx == aseg->last_idx) 00795 repeat = aseg->last_repeat; 00796 else 00797 repeat = INIT2F_choose_repeat(Initv_Table[initv]); 00798 00799 /* Do the initialization */ 00800 INITVKIND_translate(tokens, initv, aseg->etype, repeat); 00801 } /* for */ 00802 } /* INIT2F_Translate_Array_Value */ 00803 00804 static void 00805 INIT2F_Implied_DoLoop(TOKEN_BUFFER tokens, /* Append to this buffer */ 00806 TOKEN_BUFFER *abase_tokens, /* Array-base reference */ 00807 const ARRAY_SEGMENT *aseg) /* Array segment info */ 00808 { 00809 /* Use an implied do-loop to initialize array elements from 00810 * index "aseg->start_ofst/TY_size(aseg->etype)" to index 00811 * "aseg->end_ofst/TY_size(aseg->etype)", where the difference 00812 * between these indices should be exactly "aseg->num_initvs-1". 00813 * 00814 * We assume all arrays have been normalized to be stride 1 arrays, 00815 * although, if necessary, we can easily modify this later to 00816 * handle larger strides (TODO?). Also, it may be worthwhile to 00817 * extend this to handle initialization of an array of substrings. 00818 * Currently, we only handle initialization of an array of complete 00819 * strings by means of an implied do-loop (TODO?). 00820 */ 00821 const UINT current_indent = Current_Indentation(); 00822 TOKEN_BUFFER aref_tokens; 00823 UINT ivar_idx, avar_idx; 00824 const char *ivar_name; 00825 TY_IDX atype; 00826 00827 ARB_HANDLE arb_base = TY_arb(aseg->atype); 00828 ARB_HANDLE arb = arb_base[0]; 00829 00830 /* Declare the induction variable */ 00831 ivar_idx = Stab_Lock_Tmpvar(Stab_Mtype_To_Ty(MTYPE_I8), 00832 &ST2F_Declare_Tempvar); 00833 00834 /* Put the array reference tokens in aref_tokens */ 00835 aref_tokens = New_Token_Buffer(); 00836 if (TY_AR_ndims(aseg->atype) > 1) 00837 { 00838 /* The implied do-loop only operates over a one-dimensional array, 00839 * so use an equivalence if the array is not one-dimensional. 00840 */ 00841 atype = Stab_Array_Of(aseg->etype, 00842 TY_size(aseg->atype)/TY_size(aseg->etype)); 00843 avar_idx = Stab_Lock_Tmpvar(atype, &ST2F_Declare_Tempvar); 00844 Set_Current_Indentation(PUinfo_local_decls_indent); 00845 INIT2F_Prepend_Equivalence(Data_Stmt_Tokens, *abase_tokens, avar_idx); 00846 Reclaim_Token_Buffer(abase_tokens); 00847 Set_Current_Indentation(current_indent); 00848 00849 Append_Token_String(aref_tokens, W2CF_Symtab_Nameof_Tempvar(avar_idx)); 00850 Stab_Unlock_Tmpvar(avar_idx); 00851 } 00852 else 00853 { 00854 Append_And_Reclaim_Token_List(aref_tokens, abase_tokens); 00855 } 00856 00857 /* Generate the implied do-loop */ 00858 ivar_name = W2CF_Symtab_Nameof_Tempvar(ivar_idx); 00859 Append_Token_Special(tokens, '('); 00860 Append_And_Reclaim_Token_List(tokens, &aref_tokens); 00861 Append_Token_Special(tokens, '('); 00862 Append_Token_String(tokens, ivar_name); 00863 Append_Token_Special(tokens, ')'); 00864 00865 Append_Token_Special(tokens, ','); 00866 Append_Token_String(tokens, ivar_name); 00867 Append_Token_Special(tokens, '='); 00868 00869 # if 0//June 00870 00871 Append_Token_String(tokens, 00872 Number_as_String(aseg->start_ofst/TY_size(aseg->etype) + 1, 00873 "%llu")); 00874 # endif 00875 00876 /***************************************************************************/ 00877 /* Maybe think about chang more for DATA fzhao----June */ 00878 /*here only suppose array in DATA is always one-dimension,and initialization*/ 00879 /* is for whole array */ 00880 /****************************************************************************/ 00881 TCON2F_translate(tokens, 00882 Host_To_Targ(MTYPE_I4, 00883 ARB_lbnd_val(arb)), 00884 FALSE /*is_logical*/); 00885 00886 Append_Token_Special(tokens, ','); 00887 00888 // June#if 0 00889 Append_Token_String(tokens, 00890 Number_as_String(aseg->end_ofst/TY_size(aseg->etype)+ 00891 ARB_lbnd_val(arb)-1, 00892 "%llu")); 00893 //#endif 00894 # if 0 00895 00896 TCON2F_translate(tokens, 00897 Host_To_Targ(MTYPE_I4, 00898 ARB_ubnd_val(arb)), 00899 FALSE /*is_logical*/); 00900 00901 #endif 00902 00903 Append_Token_Special(tokens, ','); 00904 Append_Token_String(tokens, Number_as_String(1, "%llu")); 00905 Append_Token_Special(tokens, ')'); 00906 00907 Stab_Unlock_Tmpvar(ivar_idx); 00908 } /* INIT2F_Implied_DoLoop */ 00909 00910 static void 00911 INIT2F_Translate_Array_Ref(TOKEN_BUFFER tokens, 00912 ST *base_object, 00913 STAB_OFFSET base_ofst, 00914 const ARRAY_SEGMENT *aseg) 00915 { 00916 /* The greatest complication here arises when the array element type 00917 * is a character string, since for this case the aseg->num_initvs 00918 * indicates the number of INITVs in the segment, not the number of 00919 * array elements that are initialized, and the first and/or last 00920 * array element may be substring initializations. We handle 00921 * such cases specially. 00922 */ 00923 const STAB_OFFSET esize = TY_size(aseg->etype); 00924 STAB_OFFSET ofst; /* Current offset when traversing array segment */ 00925 WN2F_CONTEXT context = INIT_WN2F_CONTEXT; 00926 TOKEN_BUFFER abase_tokens, aref_tokens; 00927 UINT first_idx = aseg->first_idx; 00928 INITV_IDX first_initv = aseg->initv_array[first_idx]; 00929 00930 00931 if (aseg->num_initvs == 1 && 00932 INIT2F_is_string_initv(Initv_Table[first_initv],aseg->etype)) 00933 { 00934 /* Use an implied do-loop to do this special F90 initialization */ 00935 00936 abase_tokens = New_Token_Buffer(); 00937 WN2F_Offset_Symref(abase_tokens, 00938 base_object, 00939 Stab_Pointer_To(ST_type(base_object)), 00940 aseg->atype, 00941 base_ofst, 00942 context); 00943 00944 aref_tokens = New_Token_Buffer(); 00945 INIT2F_Implied_DoLoop(aref_tokens, /* Append loop to this buffer */ 00946 &abase_tokens,/* Array-base reference tokens */ 00947 aseg); /* Array segment information */ 00948 INIT2F_Append_Initializer(tokens, &aref_tokens, 1); 00949 } 00950 else if (aseg->start_ofst % TY_size(aseg->etype) != 0 || 00951 aseg->end_ofst % TY_size(aseg->etype) != 0 || 00952 (!aseg->missing_padding && 00953 aseg->num_initvs != 00954 (aseg->end_ofst - aseg->start_ofst)/TY_size(aseg->etype))) 00955 { 00956 /* Special handling for substring initialization, where initv_repeat 00957 * accounts for how many times the current initv has already been 00958 * repeated. 00959 */ 00960 UINT initc, substring_size; 00961 UINT initv_idx = first_idx; 00962 INITV_IDX ini_idx = first_initv; 00963 UINT initv_repeat = INIT2F_choose_repeat(Initv_Table[ini_idx]) - aseg->first_repeat; 00964 00965 ofst = aseg->start_ofst; 00966 for (initc = 1; initc <= aseg->num_initvs; initc++) 00967 { 00968 INITV& initv = Initv_Table[ini_idx]; 00969 substring_size = Targ_String_Length(INITV_tc_val(initv)); 00970 aref_tokens = New_Token_Buffer(); 00971 INIT2F_Translate_Char_Ref(aref_tokens, 00972 base_object, 00973 aseg->etype, /* array element type */ 00974 base_ofst, /* offset to array */ 00975 (ofst/esize)*esize, /* array element ofst */ 00976 ofst%esize, /* string offset */ 00977 substring_size, /* string size */ 00978 context); 00979 INIT2F_Append_Initializer(tokens, &aref_tokens, 1); 00980 if (initc < aseg->num_initvs) { 00981 INIT2F_Next_Initv(initv, &initv_idx, &initv_repeat); 00982 ini_idx = aseg->initv_array[initv_idx]; 00983 } 00984 ofst += substring_size; 00985 } 00986 } 00987 else /* Each initv corresponds to exactly one array element */ 00988 { 00989 /* Translate the array base reference */ 00990 abase_tokens = New_Token_Buffer(); 00991 WN2F_Offset_Symref(abase_tokens, 00992 base_object, 00993 Stab_Pointer_To(ST_type(base_object)), 00994 aseg->atype, 00995 base_ofst, 00996 context); 00997 00998 /* Append indexing expression. 00999 */ 01000 if (aseg->num_initvs*TY_size(aseg->etype) == TY_size(aseg->atype)) 01001 { 01002 /* The whole array is initialized, so nothing else need be done */ 01003 INIT2F_Append_Initializer(tokens, &abase_tokens, 1); 01004 } 01005 else if (aseg->num_initvs > 4) 01006 { 01007 /* Use an implied do-loop to do the initialization */ 01008 aref_tokens = New_Token_Buffer(); 01009 INIT2F_Implied_DoLoop(aref_tokens, /* Append loop to this buffer */ 01010 &abase_tokens,/* Array-base reference tokens */ 01011 aseg); /* Array segment information */ 01012 INIT2F_Append_Initializer(tokens, &aref_tokens, 1); 01013 } 01014 else if (aseg->num_initvs > 0) 01015 { 01016 INT elt; 01017 01018 /* Refer to each array element separately */ 01019 ofst = aseg->start_ofst; 01020 for (elt = 0; elt < aseg->num_initvs; elt++) 01021 { 01022 aref_tokens = New_Token_Buffer(); 01023 Append_And_Copy_Token_List(aref_tokens, abase_tokens); 01024 TY2F_Translate_ArrayElt(aref_tokens, aseg->atype, ofst); 01025 INIT2F_Append_Initializer(tokens, &aref_tokens, 1); 01026 ofst += TY_size(aseg->etype); 01027 } 01028 Reclaim_Token_Buffer(&abase_tokens); 01029 } 01030 } 01031 } /* INIT2F_Translate_Array_Ref */ 01032 01033 /*--------- Routines to handle initialization for various types --------* 01034 *----------------------------------------------------------------------*/ 01035 01036 static void 01037 INIT2F_translate(TOKEN_BUFFER lhs_tokens, 01038 TOKEN_BUFFER rhs_tokens, 01039 ST *base_object, /* Top level object */ 01040 STAB_OFFSET base_ofst, /* Offset from top level base */ 01041 STAB_OFFSET *object_ofst, /* Offset within object type */ 01042 TY_IDX object_ty, /* Sub-object type at base_ofst */ 01043 INITV_IDX *initv_array, /* The initv array */ 01044 UINT *initv_idx, /* next initv for sub-object */ 01045 UINT *initv_times); /* times initv already repeated */ 01046 01047 static void 01048 INIT2F_ptr_or_scalar(TOKEN_BUFFER lhs_tokens, 01049 TOKEN_BUFFER rhs_tokens, 01050 ST *base_object, 01051 STAB_OFFSET base_ofst, 01052 STAB_OFFSET *object_ofst, 01053 TY_IDX object_ty, 01054 INITV_IDX *initv_array, 01055 UINT *initv_idx, 01056 UINT *initv_times) 01057 { 01058 /* Initialization of a pointer or a scalar object, which means 01059 * the INITV must be INITVKIND_SYMOFF or INITVKIND_VAL (not 01060 * INITVKIND_PAD or INITVKIND_block). 01061 */ 01062 INITV& initv = Initv_Table[initv_array[*initv_idx]]; 01063 WN2F_CONTEXT context = INIT_WN2F_CONTEXT; 01064 TOKEN_BUFFER sym_tokens; 01065 01066 ASSERT_DBG_WARN(*object_ofst == 0, 01067 (DIAG_W2F_UNEXPEXTED_OFFSET, 01068 *object_ofst, "INITV2F_ptr_or_scalar")); 01069 01070 01071 INITVKIND_translate(rhs_tokens, 01072 initv_array[*initv_idx], 01073 object_ty, 01074 1) ; 01075 01076 INIT2F_Next_Initv(initv, initv_idx, initv_times); 01077 01078 /* Get the lhs of the initializer */ 01079 sym_tokens = New_Token_Buffer(); 01080 WN2F_Offset_Symref(sym_tokens, 01081 base_object, 01082 Stab_Pointer_To(ST_type(base_object)), 01083 object_ty, 01084 base_ofst, 01085 context); 01086 INIT2F_Append_Initializer(lhs_tokens, &sym_tokens, 1); 01087 01088 /* object_ofst denotes the offset from the base of this object */ 01089 *object_ofst += TY_size(object_ty); 01090 01091 } /* INIT2F_ptr_or_scalar */ 01092 01093 01094 static void 01095 INIT2F_array(TOKEN_BUFFER lhs_tokens, 01096 TOKEN_BUFFER rhs_tokens, 01097 ST *base_object, 01098 STAB_OFFSET base_ofst, 01099 STAB_OFFSET *object_ofst, 01100 TY_IDX object_ty, 01101 INITV_IDX *initv_array, 01102 UINT *initv_idx, 01103 UINT *initv_times) 01104 { 01105 /* Initialization of an array, which is not a character string. 01106 * We have several choices as to how to do the initialization, 01107 * where options are (in order of preference) initialization of 01108 * the whole array, an implied do-loop initialization, or 01109 * initialization of individual array elements. 01110 */ 01111 01112 ARRAY_SEGMENT a_segment; 01113 01114 ASSERT_DBG_FATAL(TY_Is_Array(object_ty) && !TY_is_character(object_ty), 01115 (DIAG_W2F_UNEXPECTED_TYPE_KIND, 01116 TY_kind(object_ty), "INITV2F_array")); 01117 01118 INIT2F_Skip_Padding(initv_array, 01119 object_ty, 01120 object_ofst, 01121 initv_idx); 01122 while (*object_ofst < TY_size(object_ty)) 01123 { 01124 /* Translate each non-padding initializer segment into a sub-array 01125 * initialization. 01126 */ 01127 01128 INITV& initv = Initv_Table[initv_array[*initv_idx]]; 01129 01130 #if 0 01131 ASSERT_DBG_FATAL(!(TY_Is_Array_Of_Chars(object_ty) && 01132 INITV_kind(initv) == INITVKIND_VAL && 01133 TCON_ty(INITV_tc_val(initv)) == MTYPE_STRING), 01134 (DIAG_W2F_UNEXPECTED_INITV, 01135 INITV_kind(initv), "INITV2F_array")); 01136 #endif 01137 /* Get the last consecutive initv and the array segment-size 01138 * implied by this consecutive sequence of initializers. 01139 */ 01140 a_segment = 01141 INIT2F_Get_Array_Segment(initv_array, 01142 initv_idx, 01143 initv_times, 01144 object_ty, 01145 object_ofst); 01146 01147 /* Translate the rhs, i.e. the array-elements of this segment. 01148 */ 01149 INIT2F_Translate_Array_Value(rhs_tokens, &a_segment); 01150 01151 /* Translate the lhs, i.e. the array segment being initialized. 01152 */ 01153 INIT2F_Translate_Array_Ref(lhs_tokens, 01154 base_object, 01155 base_ofst, 01156 &a_segment); 01157 01158 /* Skip padding before initializing remaining array segments. 01159 */ 01160 INIT2F_Skip_Padding(initv_array, 01161 object_ty, 01162 object_ofst, 01163 initv_idx); 01164 01165 /* object_ofst denotes the offset from the base of 01166 * this object 01167 */ 01168 } /* while */ 01169 01170 } /* INIT2F_array */ 01171 01172 static void 01173 INIT2F_substring(TOKEN_BUFFER lhs_tokens, 01174 TOKEN_BUFFER rhs_tokens, 01175 ST *base_object, 01176 STAB_OFFSET base_ofst, 01177 STAB_OFFSET *object_ofst, 01178 TY_IDX object_ty, 01179 INITV_IDX *initv_array, 01180 UINT *initv_idx, 01181 UINT *initv_times) 01182 { 01183 /* Initialization of an array, which is a character string. 01184 * We have a couple of choices as to how to do the initialization, 01185 * where options are (in order of preference) initialization of 01186 * the whole string, or initialization of a substring. 01187 */ 01188 STAB_OFFSET substring_size; 01189 TOKEN_BUFFER substring_tokens; 01190 WN2F_CONTEXT context = INIT_WN2F_CONTEXT; 01191 01192 ASSERT_DBG_FATAL((TY_Is_String(object_ty) || 01193 TY_Is_Array_Of_Chars(object_ty)), 01194 (DIAG_W2F_UNEXPECTED_TYPE_KIND, 01195 TY_kind(object_ty), "INITV2F_substring")); 01196 01197 INIT2F_Skip_Padding(initv_array, 01198 object_ty, 01199 object_ofst, 01200 initv_idx); 01201 01202 if (*object_ofst < TY_size(object_ty)) 01203 { 01204 /* Append the substring value to the rhs */ 01205 01206 INITV_IDX initv = initv_array[*initv_idx]; 01207 INITV& ini = Initv_Table[initv]; 01208 01209 INITVKIND_translate(rhs_tokens, initv, object_ty, 1); 01210 01211 /* Append the substring reference to the lhs */ 01212 01213 substring_size = Targ_String_Length(INITV_tc_val(ini)); 01214 substring_tokens = New_Token_Buffer(); 01215 INIT2F_Translate_Char_Ref(substring_tokens, 01216 base_object, 01217 object_ty, /* character string type */ 01218 base_ofst, /* offset to array */ 01219 0, /* array element ofst */ 01220 *object_ofst, /* string offset */ 01221 substring_size, /* string size */ 01222 context); 01223 INIT2F_Append_Initializer(lhs_tokens, &substring_tokens, 1); 01224 INIT2F_Next_Initv(ini, initv_idx, initv_times); 01225 *object_ofst += substring_size; 01226 } /* if */ 01227 } /* INIT2F_substring */ 01228 01229 static void 01230 INIT2F_structured(TOKEN_BUFFER lhs_tokens, 01231 TOKEN_BUFFER rhs_tokens, 01232 ST *base_object, 01233 STAB_OFFSET *object_ofst, 01234 TY_IDX object_ty, 01235 INITV_IDX *initv_array, 01236 UINT *initv_idx, 01237 UINT *initv_times) 01238 { 01239 /* Initialization of a structure or a member of a structure. The 01240 * kind of structure may be a common, equivalence, or a RECORD 01241 * block. The initializer will be a sequence of INITVKIND_SYMOFFs, 01242 * INITVKIND_VALs and INITVKIND_PADs. 01243 */ 01244 TY_IDX initv_ty; 01245 STAB_OFFSET fld_ofst; 01246 FLD_PATH_INFO *fpath; 01247 01248 ASSERT_DBG_FATAL(TY_Is_Structured(object_ty), 01249 (DIAG_W2F_UNEXPECTED_TYPE_KIND, 01250 TY_kind(object_ty), "INITV2F_structured")); 01251 01252 /* Find the initializer for each field that has one, first skipping 01253 * past any padding. 01254 */ 01255 INIT2F_Skip_Padding(initv_array, object_ty, object_ofst, initv_idx); 01256 while (*object_ofst < TY_size(object_ty)) 01257 { 01258 /* Determine what type of initializer we have */ 01259 initv_ty = INITVKIND_ty(initv_array[*initv_idx]); 01260 01261 /* Find the field that best matches this type. This will be done 01262 * at each level of path down nested structures and as such will be 01263 * extremely inefficient, but we do not expect more than one level 01264 * of nesting for Fortran initializers (Fortran RECORDs may not 01265 * occur in DATA statements). 01266 */ 01267 fpath = TY2F_Get_Fld_Path(object_ty, initv_ty, *object_ofst); 01268 { 01269 FLD_HANDLE fld; 01270 01271 if (fpath == NULL || fpath->fld.Is_Null ()) 01272 { 01273 /* Could not find a suitable path so just assume the first field 01274 * that may contain the value. 01275 */ 01276 01277 FLD_ITER fld_iter = Make_fld_iter (TY_fld(Ty_Table[object_ty])); 01278 01279 do 01280 { 01281 fld = FLD_HANDLE (fld_iter); 01282 } while (!FLD_last_field (fld_iter++) && 01283 !OFFSET_IS_IN_FLD(fld, *object_ofst)) ; 01284 } else 01285 fld = fpath->fld; 01286 01287 if (fpath != NULL) 01288 TY2F_Free_Fld_Path(fpath); 01289 01290 /* Translate the initialization of this field: We rely on only 01291 * one level fields here, so the offset within the found field 01292 * will be the total of [offset - FLD_ofst(fld)]. 01293 */ 01294 fld_ofst = *object_ofst - FLD_ofst(fld); 01295 INIT2F_translate(lhs_tokens, 01296 rhs_tokens, 01297 base_object, 01298 FLD_ofst(fld), 01299 &fld_ofst, /* return ofst from base of field */ 01300 FLD_type(fld), 01301 initv_array, 01302 initv_idx, 01303 initv_times); 01304 01305 /* Skip padding before initializing remainding fields. 01306 */ 01307 *object_ofst = FLD_ofst(fld) + fld_ofst; 01308 INIT2F_Skip_Padding(initv_array, 01309 object_ty, 01310 object_ofst, 01311 initv_idx); 01312 } 01313 } /* while */ 01314 } /* INIT2F_structured */ 01315 01316 static void 01317 INIT2F_translate(TOKEN_BUFFER lhs_tokens, 01318 TOKEN_BUFFER rhs_tokens, 01319 ST *base_object, /* Top level base-object */ 01320 STAB_OFFSET base_ofst, /* Offset from top level base */ 01321 STAB_OFFSET *object_ofst, /* Offset from base_member */ 01322 TY_IDX object_ty, /* Base_member type at base_ofst */ 01323 INITV_IDX *initv_array, /* The initv array */ 01324 UINT *initv_idx, /* next initv for sub-object */ 01325 UINT *initv_times) /* times initv already repeated */ 01326 { 01327 if (TY_Is_Structured(object_ty)) 01328 { 01329 INIT2F_structured(lhs_tokens, 01330 rhs_tokens, 01331 base_object, 01332 object_ofst, 01333 object_ty, 01334 initv_array, 01335 initv_idx, 01336 initv_times); 01337 } 01338 else if (TY_Is_Array(object_ty)) 01339 { 01340 if (TY_is_character(Ty_Table[object_ty])) 01341 01342 INIT2F_substring(lhs_tokens, 01343 rhs_tokens, 01344 base_object, 01345 base_ofst, 01346 object_ofst, 01347 object_ty, 01348 initv_array, 01349 initv_idx, 01350 initv_times); 01351 else 01352 INIT2F_array(lhs_tokens, 01353 rhs_tokens, 01354 base_object, 01355 base_ofst, 01356 object_ofst, 01357 object_ty, 01358 initv_array, 01359 initv_idx, 01360 initv_times); 01361 } 01362 else if (TY_Is_Pointer_Or_Scalar(object_ty)) 01363 { 01364 INIT2F_ptr_or_scalar(lhs_tokens, 01365 rhs_tokens, 01366 base_object, 01367 base_ofst, 01368 object_ofst, 01369 object_ty, 01370 initv_array, 01371 initv_idx, 01372 initv_times); 01373 } 01374 else 01375 ASSERT_DBG_WARN(FALSE, 01376 (DIAG_W2F_UNEXPECTED_SYMBOL, "INITV2F_translate")); 01377 } /* INIT2F_translate */ 01378 01379 01380 /*------------------------- Exported Routines --------------------------*/ 01381 /*----------------------------------------------------------------------*/ 01382 01383 void 01384 INITO2F_translate(TOKEN_BUFFER tokens, INITO_IDX inito) 01385 { 01386 /* Create a DATA statement, followed by a newline character, 01387 * provided the object initialized is not a RECORD type (for 01388 * which the initializer should be noted on the type, not on 01389 * the object). 01390 */ 01391 TOKEN_BUFFER lhs_tokens = New_Token_Buffer(); /* memloc initialized */ 01392 TOKEN_BUFFER rhs_tokens = New_Token_Buffer(); /* initializer values */ 01393 UINT initv_idx = 0; 01394 UINT initv_times = 0; 01395 TY_IDX object_ty = ST_type(INITO_st(inito)); 01396 STAB_OFFSET object_ofst = 0; 01397 INITV_IDX *initv_array; 01398 01399 ASSERT_DBG_FATAL(!TY_Is_Structured(object_ty) || 01400 Stab_Is_Common_Block(INITO_st(inito)) || 01401 Stab_Is_Equivalence_Block(INITO_st(inito)), 01402 (DIAG_W2F_UNEXPECTED_SYMBOL, "INITO2F_translate")); 01403 01404 /* There may be a list of INITO's initializing the same object, so 01405 * accumulate the INITV's immediately under this list of INITOs into 01406 * a single array of INITV's to aid the following computation. All 01407 * INITVKIND_BLOCK initvs will have been flattened out, so we only 01408 * have INITVKIND_VAL, INITVKIND_SYMOFF, and INITVKIND_PAD in this 01409 * array. 01410 */ 01411 initv_array = INIT2F_Get_Initv_Array(INITO_st(inito), inito); 01412 01413 /* Activate an initialization based on the kind of object to be 01414 * initialized. We expect the INITO list for this object to cover 01415 * the entire extent of the object. 01416 */ 01417 INIT2F_translate(lhs_tokens, 01418 rhs_tokens, 01419 INITO_st(inito), /* Top level object */ 01420 0, /* Offset from top level base */ 01421 &object_ofst, /* Offset within object type */ 01422 object_ty, /* Sub-object type at base-offset */ 01423 initv_array, /* The initv array */ 01424 &initv_idx, /* first initv for sub-object */ 01425 &initv_times); /* times initv already repeated */ 01426 01427 /* Combine the lhs and the rhs and free up the initv array. 01428 */ 01429 FREE(initv_array); 01430 Append_F77_Indented_Newline(tokens, 1, NULL/*label*/); 01431 Append_Token_String(tokens, "DATA"); 01432 Append_And_Reclaim_Token_List(tokens, &lhs_tokens); 01433 Append_Token_Special(tokens, '/'); 01434 Append_And_Reclaim_Token_List(tokens, &rhs_tokens); 01435 Append_Token_Special(tokens, '/'); 01436 } /* INITO2F_translate */ 01437 01438 01439 void 01440 PARAMETER2F_translate(TOKEN_BUFFER tokens, INITO_IDX inito) 01441 { 01442 /* Create a DATA statement, followed by a newline character, 01443 * provided the object initialized is not a RECORD type (for 01444 * which the initializer should be noted on the type, not on 01445 * the object). 01446 */ 01447 TOKEN_BUFFER lhs_tokens = New_Token_Buffer(); /* memloc initialized */ 01448 TOKEN_BUFFER rhs_tokens = New_Token_Buffer(); /* initializer values */ 01449 UINT initv_idx = 0; 01450 UINT initv_times = 0; 01451 TY_IDX object_ty = ST_type(INITO_st(inito)); 01452 STAB_OFFSET object_ofst = 0; 01453 INITV_IDX *initv_array; 01454 01455 ASSERT_DBG_FATAL(!TY_Is_Structured(object_ty) || 01456 Stab_Is_Common_Block(INITO_st(inito)) || 01457 Stab_Is_Equivalence_Block(INITO_st(inito)), 01458 (DIAG_W2F_UNEXPECTED_SYMBOL, "INITO2F_translate")); 01459 01460 /* There may be a list of INITO's initializing the same object, so 01461 * accumulate the INITV's immediately under this list of INITOs into 01462 * a single array of INITV's to aid the following computation. All 01463 * INITVKIND_BLOCK initvs will have been flattened out, so we only 01464 * have INITVKIND_VAL, INITVKIND_SYMOFF, and INITVKIND_PAD in this 01465 * array. 01466 */ 01467 initv_array = INIT2F_Get_Initv_Array(INITO_st(inito), inito); 01468 01469 /* Activate an initialization based on the kind of object to be 01470 * initialized. We expect the INITO list for this object to cover 01471 * the entire extent of the object. 01472 */ 01473 INIT2F_translate(lhs_tokens, 01474 rhs_tokens, 01475 INITO_st(inito), /* Top level object */ 01476 0, /* Offset from top level base */ 01477 &object_ofst, /* Offset within object type */ 01478 object_ty, /* Sub-object type at base-offset */ 01479 initv_array, /* The initv array */ 01480 &initv_idx, /* first initv for sub-object */ 01481 &initv_times); /* times initv already repeated */ 01482 01483 /* Combine the lhs and the rhs and free up the initv array. 01484 */ 01485 FREE(initv_array); 01486 Append_F77_Indented_Newline(tokens, 1, NULL/*label*/); 01487 Append_Token_String(tokens, "PARAMETER ("); 01488 Append_Token_String(tokens, ST_name(INITO_st(inito))); 01489 Append_Token_Special(tokens, '='); 01490 if (TY_Is_Structured(object_ty)) { 01491 Append_Token_String(tokens,W2CF_Symtab_Nameof_Ty(object_ty)); 01492 Append_Token_Special(tokens,'('); 01493 } 01494 else 01495 Append_Token_String(tokens, "(/"); 01496 Append_And_Reclaim_Token_List(tokens, &rhs_tokens); 01497 if (!TY_Is_Structured(object_ty)) 01498 Append_Token_Special(tokens,'/'); 01499 Append_Token_String(tokens, "))"); 01500 } /* INITO2F_translate */ 01501 01502