Subversion Repositories tendra.SVN

Rev

Rev 5 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line -... Line 1...
- 
 
 1 
/*
- 
 
 2 
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
- 
 
 3 
 * All rights reserved.
- 
 
 4 
 *
- 
 
 5 
 * Redistribution and use in source and binary forms, with or without
- 
 
 6 
 * modification, are permitted provided that the following conditions are met:
- 
 
 7 
 *
- 
 
 8 
 * 1. Redistributions of source code must retain the above copyright notice,
- 
 
 9 
 *    this list of conditions and the following disclaimer.
- 
 
 10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
- 
 
 11 
 *    this list of conditions and the following disclaimer in the documentation
- 
 
 12 
 *    and/or other materials provided with the distribution.
- 
 
 13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
- 
 
 14 
 *    may be used to endorse or promote products derived from this software
- 
 
 15 
 *    without specific, prior written permission.
- 
 
 16 
 *
- 
 
 17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
- 
 
 18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- 
 
 19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- 
 
 20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
- 
 
 21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- 
 
 22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- 
 
 23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- 
 
 24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- 
 
 25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- 
 
 26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- 
 
 27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 28 
 *
- 
 
 29 
 * $Id$
- 
 
 30 
 */
1 
/*
 31 
/*
2 
    Copyright (c) 1993 Open Software Foundation, Inc.
 32 
    Copyright (c) 1993 Open Software Foundation, Inc.
3 
 
 33 
 
4 
 
 34 
 
5 
    All Rights Reserved
 35 
    All Rights Reserved
Line 24... Line 54...
24 
    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 54 
    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
25 
*/
 55 
*/
26 
 
 56 
 
27 
/*
 57 
/*
28 
    		 Crown Copyright (c) 1997
 58 
    		 Crown Copyright (c) 1997
29
59 
 
30 
    This TenDRA(r) Computer Program is subject to Copyright
 60 
    This TenDRA(r) Computer Program is subject to Copyright
31 
    owned by the United Kingdom Secretary of State for Defence
 61 
    owned by the United Kingdom Secretary of State for Defence
32 
    acting through the Defence Evaluation and Research Agency
 62 
    acting through the Defence Evaluation and Research Agency
33 
    (DERA).  It is made available to Recipients with a
 63 
    (DERA).  It is made available to Recipients with a
34 
    royalty-free licence for its use, reproduction, transfer
 64 
    royalty-free licence for its use, reproduction, transfer
35 
    to other parties and amendment for any purpose not excluding
 65 
    to other parties and amendment for any purpose not excluding
36 
    product development provided that any such use et cetera
 66 
    product development provided that any such use et cetera
37 
    shall be deemed to be acceptance of the following conditions:-
 67 
    shall be deemed to be acceptance of the following conditions:-
38
68 
 
39 
        (1) Its Recipients shall ensure that this Notice is
 69 
        (1) Its Recipients shall ensure that this Notice is
40 
        reproduced upon any copies or amended versions of it;
 70 
        reproduced upon any copies or amended versions of it;
41
71 
 
42 
        (2) Any amended version of it shall be clearly marked to
 72 
        (2) Any amended version of it shall be clearly marked to
43 
        show both the nature of and the organisation responsible
 73 
        show both the nature of and the organisation responsible
44 
        for the relevant amendment or amendments;
 74 
        for the relevant amendment or amendments;
45
75 
 
46 
        (3) Its onward transfer from a recipient to another
 76 
        (3) Its onward transfer from a recipient to another
47 
        party shall be deemed to be that party's acceptance of
 77 
        party shall be deemed to be that party's acceptance of
48 
        these conditions;
 78 
        these conditions;
49
79 
 
50 
        (4) DERA gives no warranty or assurance as to its
 80 
        (4) DERA gives no warranty or assurance as to its
51 
        quality or suitability for any purpose and DERA accepts
 81 
        quality or suitability for any purpose and DERA accepts
52 
        no liability whatsoever in relation to any use to which
 82 
        no liability whatsoever in relation to any use to which
53 
        it may be put.
 83 
        it may be put.
54 
*/
 84 
*/
Line 60... Line 90...
60 
$Date: 1998/02/04 15:49:11 $
 90 
$Date: 1998/02/04 15:49:11 $
61 
$Revision: 1.2 $
 91 
$Revision: 1.2 $
62 
$Log: tempdecs.c,v $
 92 
$Log: tempdecs.c,v $
63 
 * Revision 1.2  1998/02/04  15:49:11  release
 93 
 * Revision 1.2  1998/02/04  15:49:11  release
64 
 * Added OSF copyright message.
 94 
 * Added OSF copyright message.
65 
 *
 95 
 *
66 
 * Revision 1.1.1.1  1998/01/17  15:55:58  release
 96 
 * Revision 1.1.1.1  1998/01/17  15:55:58  release
67 
 * First version to be checked into rolling release.
 97 
 * First version to be checked into rolling release.
68 
 *
 98 
 *
69 
 * Revision 1.2  1996/10/04  16:04:47  pwe
 99 
 * Revision 1.2  1996/10/04  16:04:47  pwe
70 
 * add banners and mod for PWE ownership
 100 
 * add banners and mod for PWE ownership
71 
 *
 101 
 *
72 
**********************************************************************/
 102 
**********************************************************************/
73 
 
 103 
 
74 
 
 104 
 
75 
#include "config.h"
 105 
#include "config.h"
76 
#include "tags.h"
 106 
#include "tags.h"
77 
#include "common_types.h"
 107 
#include "common_types.h"
78 
#include "exp.h"
 108 
#include "exp.h"
79 
#include "const.h"
 109 
#include "const.h"
Line 89... Line 119...
89 
 
 119 
 
90 
 
 120 
 
91 
bool tempdecopt;	/* flag to allow this optimisation, set in main() */
 121 
bool tempdecopt;	/* flag to allow this optimisation, set in main() */
92 
static int nouses;
 122 
static int nouses;
93 
static bool useinpar;
 123 
static bool useinpar;
94 
static int param_uses PROTO_S ((exp));
 124 
static int param_uses(exp);
95 
static int locate_param PROTO_S ((exp));
 125 
static int locate_param(exp);
96
126 
 
97 
bool APPLYLIKE PROTO_N ((e)) PROTO_T (exp e)
 127 
bool APPLYLIKE(exp e)
98 
{
 128 
{
99 
  if(name(e)==apply_tag )
 129 
  if (name(e) ==apply_tag)
100 
    return 1;
 - 
 
101 
  if(name(e)==apply_general_tag)
 - 
 
102 
    return 1;
 130 
    return 1;
- 
 
 131 
  if (name(e) ==apply_general_tag)
- 
 
 132 
    return 1;
103 
  if(name(e)==round_tag)
 133 
  if (name(e) ==round_tag)
104 
    if(name(sh(e))==ulonghd||architecture!=POWERPC_CODE)
 134 
    if (name(sh(e)) ==ulonghd||architecture!=POWERPC_CODE)
105 
      return 1;
 135 
      return 1;
106 
  return 0;
 136 
  return 0;
107 
}
 137 
}
108 
/* RETURNS_R_RESULT returns 1 if the exp returns R_RESULT when evaluated */
 138 
/* RETURNS_R_RESULT returns 1 if the exp returns R_RESULT when evaluated */
109 
bool RETURNS_R_RESULT PROTO_N ((e)) PROTO_T (exp e )
 139 
bool RETURNS_R_RESULT(exp e)
110 
{
 140 
{
111 
  if(name(e)==apply_tag && valregable(sh(e)))
 141 
  if (name(e) ==apply_tag && valregable(sh(e)))
112 
  {
 142 
  {
113 
    return 1;
 143 
    return 1;
114 
  }
 144 
  }
115 
  if(name(e)==apply_general_tag && valregable(sh(e)))
 145 
  if (name(e) ==apply_general_tag && valregable(sh(e)))
116 
  {
 146 
  {
117 
    return 1;
 147 
    return 1;
118 
  }
 148 
  }
119 
  if(name(e)==round_tag)
 149 
  if (name(e) ==round_tag)
120 
  {
 150 
  {
121 
    if(name(sh(e))==ulonghd||architecture!=POWERPC_CODE)
 151 
    if (name(sh(e)) ==ulonghd||architecture!=POWERPC_CODE)
122 
      return 1;
 152 
      return 1;
123 
  }
 153 
  }
124 
  return 0;
 154 
  return 0;
125 
}
 155 
}
126 
/* RETURNS_FR_RESULT returns 1 if the exp returns FR_RESULT when evaluated */
 156 
/* RETURNS_FR_RESULT returns 1 if the exp returns FR_RESULT when evaluated */
127 
bool RETURNS_FR_RESULT PROTO_N ((e)) PROTO_T (exp e)
 157 
bool RETURNS_FR_RESULT(exp e)
128 
{
 158 
{
129 
  if(name(e)==apply_tag && is_floating(name(sh(e))))
 159 
  if (name(e) ==apply_tag && is_floating(name(sh(e))))
130 
  {
 160 
  {
131 
    return 1;
 161 
    return 1;
132 
  }
 162 
  }
133 
  if(name(e)==apply_general_tag && is_floating(name(sh(e))))
 163 
  if (name(e) ==apply_general_tag && is_floating(name(sh(e))))
134 
  {
 164 
  {
135 
    return 1;
 165 
    return 1;
136 
  }
 166 
  }
137 
  return 0;
 167 
  return 0;
138 
}
 168 
}
139 
 
 169 
 
140 
 
 170 
 
141 
int trace_uses PROTO_N ((e,id)) PROTO_T (exp e X exp id)
 171 
int trace_uses(exp e, exp id)
142 
{
 172 
{
143 
  /*
 173 
  /*
144 
   * reduces nouses for each non-assignment use of id encountered in e; sets
 174 
   * reduces nouses for each non-assignment use of id encountered in e; sets
145 
   * useinpar if use in actual parameter (or function) posn terminates with 0 on
 175 
   * useinpar if use in actual parameter (or function) posn terminates with 0 on
146 
   * applications or jumps terminates with 2 on assignment to id otherwise
 176 
   * applications or jumps terminates with 2 on assignment to id otherwise
147 
   * delivers 1
 177 
   * delivers 1
148 
   * 0 is returned if trace_uses runs into a dead end
178 
   * 0 is returned if trace_uses runs into a dead end
149 
   * 2 is returned if trace_uses runs into another assignment
 179 
   * 2 is returned if trace_uses runs into another assignment
150 
   * 1 is returned if still searching ok so as soon as 0 or 2 is returned
180 
   * 1 is returned if still searching ok so as soon as 0 or 2 is returned
151 
   * the recursion ends quickly
 181 
   * the recursion ends quickly
152 
   */
 182 
   */
153
183 
 
154 
  if(APPLYLIKE(e))
 184 
  if (APPLYLIKE(e))
155 
  {
 185 
  {
156 
    /* u is nouses before we start to scan the parameters */
 186 
    /* u is nouses before we start to scan the parameters */
157 
    int u = nouses;
 187 
    int u = nouses;
158 
    int p = 1;
 188 
    int p = 1;
159 
    exp l = son(e);
 189 
    exp l = son(e);
160
190 
 
161 
    while (p == 1)
 191 
    while (p == 1)
162 
    {
 192 
    {
163 
      p = trace_uses(l, id);
 193 
      p = trace_uses(l, id);
164 
      if (u != nouses || p == 2)
 194 
      if (u != nouses || p == 2)
165 
      {
 195 
      {
166 
	/* We found a use of the ident or we found an assignment to it */
 196 
	/* We found a use of the ident or we found an assignment to it */
167 
	useinpar = 1;
 197 
	useinpar = 1;
168 
      }
 198 
      }
169
199 
 
170 
      if (p == 0)
 200 
      if (p == 0)
171 
	nouses = u;
 201 
	nouses = u;
172 
      if (last(l))
 202 
      if (last(l))
173 
	break;
 203 
	break;
174 
      l = bro(l);
 204 
      l = bro(l);
175 
    }
 205 
    }
176 
    return 0;
 206 
    return 0;
177 
  }
 207 
  }
178 
 
 208 
 
179 
  switch (name(e))
 209 
  switch (name(e))
180 
  {
 210 
  {
Line 184... Line 214...
184 
    /* Don't want to look at sons of these tags */
 214 
    /* Don't want to look at sons of these tags */
185 
    return 1;
 215 
    return 1;
186 
   case name_tag:
 216 
   case name_tag:
187 
    {
 217 
    {
188 
      nouses -= (son(e) == id);
 218 
      nouses -= (son(e) == id);
189 
      return (1);
 219 
      return(1);
190 
    }
 220 
    }
191
221 
 
192 
   case ident_tag:
 222 
   case ident_tag:
193 
    {
 223 
    {
194 
      exp f = son(e);
 224 
      exp f = son(e);
195 
      exp s = bro(f);
 225 
      exp s = bro(f);
196 
      int a;
 226 
      int a;
197
227 
 
198 
      if ((props(e) & defer_bit) != 0)
 228 
      if ((props(e) & defer_bit)!= 0)
199 
      {
 229 
      {
200 
	exp t = f;
 230 
	exp t = f;
201
231 
 
202 
	f = s;
 232 
	f = s;
203 
	s = t;
 233 
	s = t;
204 
      }
 234 
      }
205 
      a = trace_uses(f, id);
 235 
      a = trace_uses(f, id);
206 
      if (a != 1)
 236 
      if (a != 1)
207 
	return a;
 237 
	return a;
208 
      return trace_uses(s, id);
 238 
      return trace_uses(s, id);
209 
    }
 239 
    }
210 
   case case_tag:
 240 
   case case_tag:
211 
    {
 241 
    {
212 
      trace_uses(son(e), id);
 242 
      trace_uses(son(e), id);
213 
      return 0;
 243 
      return 0;
214 
    }
 244 
    }
Line 218... Line 248...
218 
 
 248 
 
219 
   case cond_tag:
 249 
   case cond_tag:
220 
    {
 250 
    {
221 
      int el;
 251 
      int el;
222 
 
 252 
 
223 
      /* Cond tags are not treated like the default since we know
253 
      /* Cond tags are not treated like the default since we know
224 
	 that the first argument will be coded first */
 254 
	 that the first argument will be coded first */
225 
      el = trace_uses(son(e),id);
 255 
      el = trace_uses(son(e),id);
226 
      if (el != 1)
 256 
      if (el != 1)
227 
      {
 257 
      {
228 
	return el;
 258 
	return el;
Line 230... Line 260...
230 
      return 0;
 260 
      return 0;
231 
    }
 261 
    }
232 
   case seq_tag:
 262 
   case seq_tag:
233 
    {
 263 
    {
234 
      exp s = son(son(e));
 264 
      exp s = son(son(e));
235
265 
 
236 
      for (;;)
 266 
      for (;;)
237 
      {
 267 
      {
238 
	int el = trace_uses(s, id);
 268 
	int el = trace_uses(s, id);
239 
 
 269 
 
240 
	if (el != 1)
 270 
	if (el != 1)
Line 242... Line 272...
242 
	if (last(s))
 272 
	if (last(s))
243 
	  return trace_uses(bro(son(e)), id);
 273 
	  return trace_uses(bro(son(e)), id);
244 
	s = bro(s);
 274 
	s = bro(s);
245 
      }
 275 
      }
246 
    }
 276 
    }
247
277 
 
248 
   case ass_tag:
 278 
   case ass_tag:
249 
    {
 279 
    {
250 
      if (isvar(id) && name(son(e)) == name_tag && son(son(e)) == id)
 280 
      if (isvar(id) && name(son(e)) == name_tag && son(son(e)) == id)
251 
      {
 281 
      {
252 
	trace_uses(bro(son(e)), id);
 282 
	trace_uses(bro(son(e)), id);
253 
	return 2;
 283 
	return 2;
254 
      }
 284 
      }
Line 260... Line 290...
260 
    }
 290 
    }
261 
   default:
 291 
   default:
262 
    {
 292 
    {
263 
      exp s = son(e);
 293 
      exp s = son(e);
264 
      int nu = nouses;
 294 
      int nu = nouses;
265 
      int bad_arguments = 0;
295 
      int bad_arguments = 0;
266 
      /* A bad argument is one which contains an assignment or something to stop flow */
 296 
      /* A bad argument is one which contains an assignment or something to stop flow */
267 
      int good_arguments = 0;
 297 
      int good_arguments = 0;
268 
      /* A good_argument is one which contains one or more uses of id, but doesn't have
 298 
      /* A good_argument is one which contains one or more uses of id, but doesn't have
269 
	 any assignments or things to stop flow */
 299 
	 any assignments or things to stop flow */
270 
      int ret_value = 0;
 300 
      int ret_value = 0;
271
301 
 
272 
      if(s==nilexp)
 302 
      if (s==nilexp)
273 
      {
 303 
      {
274 
	/*no arguments */
 304 
	/*no arguments */
275 
	return 1;
 305 
	return 1;
276 
      }
 306 
      }
277 
      for (;;)
 307 
      for (;;)
278 
      {
 308 
      {
279 
	int monitor_uses;
 309 
	int monitor_uses;
280 
	int el;
310 
	int el;
281 
	monitor_uses = nouses;
 311 
	monitor_uses = nouses;
282 
	el = trace_uses(s, id);
 312 
	el = trace_uses(s, id);
283 
	if (el==1  && nouses < monitor_uses)
 313 
	if (el==1  && nouses < monitor_uses)
284 
	{
 314 
	{
285 
	  /* argument with uses of ident*/
 315 
	  /* argument with uses of ident*/
286 
	  good_arguments ++;
 316 
	  good_arguments ++;
287 
	}
 317 
	}
288 
	if (el != 1)
 318 
	if (el != 1)
289 
	{
319 
	{
290 
	  /* An argument corrupts the flow */
 320 
	  /* An argument corrupts the flow */
291 
	  bad_arguments++;
 321 
	  bad_arguments++;
292 
	  ret_value = el;
 322 
	  ret_value = el;
293 
	}
 323 
	}
294 
	if (last(s))
 324 
	if (last(s))
295 
	  break;
 325 
	  break;
296 
	s = bro(s);
 326 
	s = bro(s);
297 
      }
 327 
      }
298 
      if (bad_arguments==0)
 328 
      if (bad_arguments==0)
299 
      {
 329 
      {
300 
	return 1;
 330 
	return 1;
301 
	/* No problems */
 331 
	/* No problems */
302 
      }
 332 
      }
303
333 
 
304 
      if (bad_arguments==1 && good_arguments==0)
 334 
      if (bad_arguments==1 && good_arguments==0)
305 
      {
 335 
      {
306 
	/* one bad one */
 336 
	/* one bad one */
307 
	/* all the rest don't use it */
 337 
	/* all the rest don't use it */
308 
	return ret_value;
 338 
	return ret_value;
Line 311... Line 341...
311 
      return ret_value;
 341 
      return ret_value;
312 
    }
 342 
    }
313 
  }
 343 
  }
314 
}
 344 
}
315 
 
 345 
 
316 
 
 346 
 
317 
void after_a PROTO_N ((a,id)) PROTO_T (exp a X exp id)
 347 
void after_a(exp a, exp id)
318 
{
 348 
{
319 
  /* apply trace_uses to dynamic successors of a */
 349 
  /* apply trace_uses to dynamic successors of a */
320 
  exp dad;
 350 
  exp dad;
321 
  exp l;
 351 
  exp l;
322
352 
 
323 
tailrecurse:
 353 
tailrecurse:
324 
  dad = father(a);
 354 
  dad = father(a);
325 
  if (nouses == 0)
 355 
  if (nouses == 0)
326 
    return;
 356 
    return;
327 
  if (name(dad) == cond_tag || name(dad) == rep_tag
 357 
  if (name(dad) == cond_tag || name(dad) == rep_tag
Line 349... Line 379...
349 
  }
 379 
  }
350 
  a = dad;
 380 
  a = dad;
351 
  if (dad != id)
 381 
  if (dad != id)
352 
    goto tailrecurse;
 382 
    goto tailrecurse;
353 
}
 383 
}
354 
bool simple_seq PROTO_N ((e,id)) PROTO_T (exp e X exp id)
 384 
bool simple_seq(exp e, exp id)
355 
{
 385 
{
356 
#if 0
 386 
#if 0
357 
  exp dad = father(e);
 387 
  exp dad = father(e);
358 
 
 388 
 
359 
  for (;;)
 389 
  for (;;)
Line 371... Line 401...
371 
#else
 401 
#else
372 
  return 1;
 402 
  return 1;
373 
#endif
 403 
#endif
374 
}
 404 
}
375 
 
 405 
 
376 
int tempdec PROTO_N ((e,enoughs)) PROTO_T (exp e X bool enoughs)
 406 
int tempdec(exp e, bool enoughs)
377 
{
 407 
{
378 
  /*
 408 
  /*
379 
   * e is a local declaration; 'enoughs' is a misnomer to say whether there
 409 
   * e is a local declaration; 'enoughs' is a misnomer to say whether there
380 
   * are t-regs available delivers 1 if e can be allocated into t-reg or par
 410 
   * are t-regs available delivers 1 if e can be allocated into t-reg or par
381 
   * reg
 411 
   * reg
Line 391... Line 421...
391 
  if (isvar(e))
 421 
  if (isvar(e))
392 
  {
 422 
  {
393 
    for (p = pt(e); p != nilexp; p = pt(p))
 423 
    for (p = pt(e); p != nilexp; p = pt(p))
394 
    {
 424 
    {
395 
      /* find no of uses which are not assignments to id ... */
 425 
      /* find no of uses which are not assignments to id ... */
396 
      if (!last(p) && last(bro(p))
 426 
      if (!last(p) && last(bro(p))
397 
	  && name(bro(bro(p))) == ass_tag)
 427 
	  && name(bro(bro(p))) == ass_tag)
398 
      {
 428 
      {
399 
	if (!simple_seq(bro(bro(p)), e))
 429 
	if (!simple_seq(bro(bro(p)), e))
400 
	  return 0;
 430 
	  return 0;
401 
	continue;
 431 
	continue;
402 
      }
 432 
      }
403 
      nouses++;
 433 
      nouses++;
404 
    }
 434 
    }
405 
  }
 435 
  }
406 
  else
 436 
  else
407 
    nouses = no(e);
 437 
    nouses = no(e);
408 
 
 438 
 
409 
  /*
 439 
  /*
410 
   * trace simple successors to assignmnts or init to id to find if all uses
 440 
   * trace simple successors to assignmnts or init to id to find if all uses
411 
   * occur before unpredictable change of control (or another assignment to
 441 
   * occur before unpredictable change of control (or another assignment to
412 
   * id)
 442 
   * id)
413 
   */
 443 
   */
414 
 
 444 
 
415 
  if (name(son(e)) != clear_tag || isparam(e))
 445 
  if (name(son(e))!= clear_tag || isparam(e))
416 
  {
 446 
  {
417 
    after_a(son(e), e);
 447 
    after_a(son(e), e);
418 
  }
 448 
  }
419 
 
 449 
 
420 
  if (isvar(e))
 450 
  if (isvar(e))
Line 437... Line 467...
437 
      props(e) |= notparreg;
 467 
      props(e) |= notparreg;
438 
      if (isparam(e))
 468 
      if (isparam(e))
439 
      {
 469 
      {
440 
	return param_uses(e);
 470 
	return param_uses(e);
441 
      }
 471 
      }
442 
      else
472 
      else
443 
	return 100;
 473 
	return 100;
444 
    }
 474 
    }
445 
    return 100;
 475 
    return 100;
446 
  }
 476 
  }
447 
  return 0;
 477 
  return 0;
448 
}
 478 
}
449 
static int param_uses PROTO_N ((id)) PROTO_T (exp id)
 479 
static int param_uses(exp id)
450 
{
 480 
{
451 
  exp p;
 481 
  exp p;
452 
  ASSERT(isparam(id));
 482 
  ASSERT(isparam(id));
453 
  ASSERT(useinpar);
 483 
  ASSERT(useinpar);
454 
  ASSERT(nouses==0);
 484 
  ASSERT(nouses==0);
455 
  /* We found all the uses of the ident and we found one of them in a parameter list */
 485 
  /* We found all the uses of the ident and we found one of them in a parameter list */
456
486 
 
457 
  for(p=pt(id) ; p!=nilexp;p = pt(p))
 487 
  for (p=pt(id); p!=nilexp;p = pt(p))
458 
  {
 488 
  {
459 
    if (APPLYLIKE(father(p)))
 489 
    if (APPLYLIKE(father(p)))
460 
    {
 490 
    {
461 
      return locate_param(p);
 491 
      return locate_param(p);
462 
    }
 492 
    }
463 
  }
 493 
  }
464 
  /* not a simple use in a parameter list */
 494 
  /* not a simple use in a parameter list */
465 
  return 100;
 495 
  return 100;
466 
}
 496 
}
467 
static int locate_param PROTO_N ((e)) PROTO_T (exp e)
 497 
static int locate_param(exp e)
468 
{
 498 
{
469 
  exp f = father(e);
 499 
  exp f = father(e);
470 
  bool is_float = is_floating(name(sh(e)));
 500 
  bool is_float = is_floating(name(sh(e)));
471 
  exp par;
 501 
  exp par;
472
502 
 
473
503 
 
474 
  ASSERT(APPLYLIKE(f));
 504 
  ASSERT(APPLYLIKE(f));
475 
  switch (name(f))
 505 
  switch (name(f))
476 
  {
 506 
  {
477 
   case apply_general_tag:
 507 
   case apply_general_tag:
478 
    par =  son(bro(son(f)));
508 
    par =  son(bro(son(f)));
479 
    break;
 509 
    break;
480 
   case apply_tag:
 510 
   case apply_tag:
481 
    par = bro(son(f));
 511 
    par = bro(son(f));
482 
    break;
 512 
    break;
483 
   case round_tag:
 513 
   case round_tag:
484 
    par = son(f);
 514 
    par = son(f);
Line 488... Line 518...
488 
  }
 518 
  }
489 
  {
 519 
  {
490 
    int fxparam = R_FIRST_PARAM;
 520 
    int fxparam = R_FIRST_PARAM;
491 
    int flparam = FR_FIRST_PARAM;
 521 
    int flparam = FR_FIRST_PARAM;
492 
    int stparam = 0;
 522 
    int stparam = 0;
493
523 
 
494 
    for(;;)
 524 
    for (;;)
495 
    {
 525 
    {
496 
      int par_size = shape_size(sh(par));
 526 
      int par_size = shape_size(sh(par));
497
527 
 
498 
      if (par==e)
 528 
      if (par==e)
499 
      {
 529 
      {
500 
	/* We have found it */
 530 
	/* We have found it */
501 
	if (is_float)
 531 
	if (is_float)
502 
	{
 532 
	{
503 
	  if (flparam>FR_LAST_PARAM)
 533 
	  if (flparam>FR_LAST_PARAM)
504 
	    return 0;
 534 
	    return 0;
505 
	  else
 535 
	  else
506 
	    return flparam;
 536 
	    return flparam;
507 
	}
 537 
	}
508 
	else
 538 
	else
509 
	{
 539 
	{
510 
	  if(fxparam>end_param)
 540 
	  if (fxparam>end_param)
511 
	    return 0;
 541 
	    return 0;
512 
	  else
 542 
	  else
513 
	    return fxparam;
 543 
	    return fxparam;
514 
	}
 544 
	}
515 
      }
 545 
      }
Line 517... Line 547...
517 
      fxparam = (stparam/32) + R_FIRST_PARAM;
 547 
      fxparam = (stparam/32) + R_FIRST_PARAM;
518 
      if (is_floating(name(sh(par))))
 548 
      if (is_floating(name(sh(par))))
519 
      {
 549 
      {
520 
	flparam++;
 550 
	flparam++;
521 
      }
 551 
      }
522 
      if(last(par))
 552 
      if (last(par))
523 
	break;
 553 
	break;
524 
      par = bro(par);
 554 
      par = bro(par);
525 
    }
 555 
    }
526 
    return 0;
 556 
    return 0;
527 
  }
 557 
  }
528 
}
558 
}
- 
 
 559 
 
529 
 
 560 
 
530
- 
 
531 
 
 561 
 
532 
 
 562 
 
533 
 
 563 
 
534 
 
 564