OpenADFortTk (including Open64 and OpenAnalysis references)
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
be_symtab.cxx
Go to the documentation of this file.
1 /*
2 
3  Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved.
4 
5  This program is free software; you can redistribute it and/or modify it
6  under the terms of version 2 of the GNU General Public License as
7  published by the Free Software Foundation.
8 
9  This program is distributed in the hope that it would be useful, but
10  WITHOUT ANY WARRANTY; without even the implied warranty of
11  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 
13  Further, this software is distributed without any warranty that it is
14  free of the rightful claim of any third person regarding infringement
15  or the like. Any license provided herein, whether implied or
16  otherwise, applies only to this software file. Patent licenses, if
17  any, provided herein do not apply to combinations of this program with
18  other software, or any other product whatsoever.
19 
20  You should have received a copy of the GNU General Public License along
21  with this program; if not, write the Free Software Foundation, Inc., 59
22  Temple Place - Suite 330, Boston MA 02111-1307, USA.
23 
24  Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky,
25  Mountain View, CA 94043, or:
26 
27  http://www.sgi.com
28 
29  For further information regarding this notice, see:
30 
31  http://oss.sgi.com/projects/GenInfo/NoticeExplan
32 
33 */
34 
35 
36 #ifdef USE_PCH
37 #include "be_com_pch.h"
38 #endif /* USE_PCH */
39 #pragma hdrstop
40 #include "be_symtab.h"
41 #include "pu_info.h"
42 #include "cxx_memory.h"
43 
45 
47 
49 
51 
53 
54 void
56 {
57  MEM_POOL_Initialize(&Be_symtab_pool, "back end symbol table", FALSE);
58  MEM_POOL_Push(&Be_symtab_pool);
59 }
60 
61 void
63 {
64  MEM_POOL_Pop(&Be_symtab_pool);
65  MEM_POOL_Delete(&Be_symtab_pool);
66 }
67 
68 void
70 {
71  while (level >= next_level) {
72  BE_SCOPE *temp = CXX_NEW_ARRAY(BE_SCOPE, 1 + next_level * 2,
73  &Be_symtab_pool);
74  SYMTAB_IDX i;
75  for (i = 0; i < next_level; i++) {
76  temp[i] = Be_scope_tab[i];
77  }
78  next_level = 1 + next_level * 2;
79  for (; i < next_level; i++) {
80  temp[i].be_st_tab = NULL;
81  }
82  CXX_DELETE_ARRAY(Be_scope_tab, &Be_symtab_pool);
83  Be_scope_tab = temp;
84  }
85  SYMTAB_IDX i = level;
86  while (Be_scope_tab[i].be_st_tab == NULL && i > 0) {
87  Be_scope_tab[i].be_st_tab = CXX_NEW(BE_ST_TAB, &Be_symtab_pool);
88  --i;
89  }
90 }
91 
92 // Determine if the ST represents a constant
93 BOOL
95 {
96  /* make sure it's a variable (necessary check?) */
97  if ( ST_class(st) != CLASS_VAR )
98  return FALSE;
99 
100  /* make sure it's a constant */
101  if (!ST_is_const_var(st))
102  return FALSE;
103 
104  // is it a constant with unknown value?
105  if (BE_ST_unknown_const(st))
106  return FALSE;
107 
108  // uninitialized constant is the same as initialized with zero, so we
109  // don't check the ST_is_initialized bit
110 
111  /* get the type */
112  TY_IDX ty = ST_type(st);
113 
114  /* just because it's constant doesn't mean it can't change behind
115  * our backs.
116  */
117  if (TY_is_volatile(ty)) {
118  return FALSE;
119  }
120 
121  return TRUE;
122 }
123 
124 
125 // Support for ST_is_const_initialized_scalar:
127 private:
128  const ST_IDX st_idx;
129 
130 public:
131  match_inito_by_st(const ST *const st) : st_idx(ST_st_idx(st)) { }
132  match_inito_by_st(const ST_IDX esstee_idx) : st_idx(esstee_idx) { }
133 
134  BOOL operator()(INITO_IDX, const INITO *inito) const
135  { return INITO_st_idx(*inito) == st_idx; }
136 };
137 
138 // Say whether the specified ST is a constant scalar variable
139 // initialized by a constant, and if so, copy the TCON for the
140 // constant into *tcon_copy. The caller takes responsibility for
141 // entering the TCON into the table if the copy gets modified somehow
142 // and s/he wants to save the modified version.
143 BOOL
144 ST_is_const_initialized_scalar(const ST *st, TCON &tcon_copy)
145 {
146  // Make sure it is not a constant with an unknown value.
147  if (BE_ST_unknown_const(st) != 0) {
148  Is_True (FALSE, ("Asking for value of unknown const"));
149  return FALSE;
150  }
151 
152  if (!ST_is_const_initialized(st))
153  return FALSE;
154 
155  TY_IDX ty = ST_type(st);
156  TYPE_ID mtype = TY_mtype(ty);
157 
158  // exclude all non-scalars
159  if (!Is_Simple_Type(ty)) {
160  return FALSE;
161  }
162 
163  // Determine if the symbol is explicitly initialized
164  // (the for-loop is necessary to solve f90 bug #626430).
165  //
166  const ST *base;
167  for (base = st;
168  (!ST_is_initialized(base) && ST_base_idx(base) != ST_st_idx(base));
169  base = ST_base(base));
170 
172 
173  // is the value known to be initialized to zero?
174  // uninitialized is equivalent to init. to zero
175  //
176  if (!initialized || ST_init_value_zero(st)) {
177  if (MTYPE_is_integral(mtype)) {
178  tcon_copy = Host_To_Targ(mtype, 0L);
179  }
180  else {
181  tcon_copy = Host_To_Targ_Float(mtype, 0.0);
182  }
183  return TRUE;
184  }
185 
186  // try to find the object that inits us; it must be at the same
187  // scope level.
188  INITO_IDX inito_idx = For_all_until(Inito_Table,
189  ST_IDX_level(ST_st_idx(st)),
190  match_inito_by_st(st));
191 
192  /* make sure we found it */
193  if (inito_idx == (INITO_IDX) 0)
194  return FALSE;
195 
196  /* make sure we have a value */
197  INITV &inov = Initv_Table[INITO_val(inito_idx)];
198 
199  switch (INITV_kind(inov)) {
200  case INITVKIND_ZERO:
201  tcon_copy = Host_To_Targ(mtype, 0L);
202  return TRUE;
203  case INITVKIND_ONE:
204  tcon_copy = Host_To_Targ(mtype, 1L);
205  return TRUE;
206  case INITVKIND_VAL:
207  tcon_copy = Tcon_Table[INITV_tc(inov)];
208  return TRUE;
209  }
210  return FALSE;
211 }
212 
213 
214 extern INITV_IDX
215 ST_has_initv(const ST *st)
216 {
217  if (!ST_is_initialized (st))
218  return (INITV_IDX) 0;
219 
220  TY_IDX ty = ST_type(st);
221 
222  // try to find the object that inits us; it must be at the same
223  // scope level.
224  INITO_IDX inito_idx;
226  match_inito_by_st(st));
227 
228  if (inito_idx == (INITO_IDX) 0) {
229  return (INITV_IDX) 0;
230  }
231  else {
232  return INITO_val(inito_idx);
233  }
234 }
235 
236 
237 // Determine if the ST represents a constant scalar variable that has
238 // a known initialized value. If true, returns the INITV_IDX for the
239 // value.
240 extern INITV_IDX
242 {
243  // Make sure it is not a constant with an unknown value.
244  if (BE_ST_unknown_const(st) != 0) {
245  Is_True (FALSE, ("Asking for value/initv of unknown const"));
246  return (INITV_IDX) 0;
247  }
248 
249  if (!ST_is_const_initialized(st))
250  return (INITV_IDX) 0;
251 
252  return ST_has_initv(st);
253 }