Subversion Repositories tendra.SVN

Rev

Rev 5 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
6 7u83 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 
 */
31 
/*
2 7u83 32 
    		 Crown Copyright (c) 1997
6 7u83 33 
 
2 7u83 34 
    This TenDRA(r) Computer Program is subject to Copyright
35 
    owned by the United Kingdom Secretary of State for Defence
36 
    acting through the Defence Evaluation and Research Agency
37 
    (DERA).  It is made available to Recipients with a
38 
    royalty-free licence for its use, reproduction, transfer
39 
    to other parties and amendment for any purpose not excluding
40 
    product development provided that any such use et cetera
41 
    shall be deemed to be acceptance of the following conditions:-
6 7u83 42 
 
2 7u83 43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
6 7u83 45 
 
2 7u83 46 
        (2) Any amended version of it shall be clearly marked to
47 
        show both the nature of and the organisation responsible
48 
        for the relevant amendment or amendments;
6 7u83 49 
 
2 7u83 50 
        (3) Its onward transfer from a recipient to another
51 
        party shall be deemed to be that party's acceptance of
52 
        these conditions;
6 7u83 53 
 
2 7u83 54 
        (4) DERA gives no warranty or assurance as to its
55 
        quality or suitability for any purpose and DERA accepts
56 
        no liability whatsoever in relation to any use to which
57 
        it may be put.
58 
*/
59 
 
60 
 
6 7u83 61 
/* 	$Id$	 */
2 7u83 62 
 
63 
#ifndef lint
6 7u83 64 
static char vcid[] = "$Id$";
2 7u83 65 
#endif /* lint */
66 
 
67 
/*
68 
$Log: inlinechoice.c,v $
69 
 * Revision 1.1.1.1  1998/01/17  15:56:00  release
70 
 * First version to be checked into rolling release.
71 
 *
72 
 * Revision 1.3  1995/09/29  09:45:14  john
73 
 * Added apply_general case
74 
 *
75 
 * Revision 1.2  1995/03/29  14:03:39  john
76 
 * Changes to keep tcheck happy
77 
 *
78 
 * Revision 1.1.1.1  1995/03/23  10:39:36  john
79 
 * Entered into CVS
80 
 *
81 
 * Revision 1.10  1995/03/23  10:05:39  john
82 
 * Minor modification
83 
 *
84 
 * Revision 1.9  1995/01/26  13:41:41  john
85 
 * Removed dead code.
86 
 *
87 
 * Revision 1.8  1995/01/20  15:12:59  john
88 
 * Repaced literal with #define
89 
 *
90 
*/
91 
 
92 
 
93 
#include "config.h"
94 
#include "common_types.h"
95 
#include "installglob.h"
96 
#include "exp.h"
97 
#include "expmacs.h"
98 
#include "tags.h"
99 
#include "flags.h"
100 
#include "shapemacs.h"
101 
#include "inl_norm.h"
102 
 
103 
#define crit_inline	120
104 
#define crit_decs	5
105 
#define crit_decsatapp 5
106 
#define apply_cost      3
107 
 
6 7u83 108 
static int  complexity(exp e, int count, int newdecs);
2 7u83 109 
static last_new_decs = -999;
110 
 
111 
/*
112 
    APPLY COMPLEXITY TO A LIST OF EXPRESSIONS
113 
*/
114 
 
115 
int sbl
6 7u83 116 
(exp e, int count, int newdecs)
2 7u83 117 
{
6 7u83 118 
  int c = complexity(e, count, newdecs);
119 
  if (c < 0) return(c);
120 
  if (last(e)) return(c);
121 
  return(sbl(bro(e), c, newdecs));
2 7u83 122 
}
123 
 
124 
 
125 
/*
126 
    FIND THE COMPLEXITY OF AN EXPRESSION
127 
 
6 7u83 128 
    This routine examines the structure of e to see if its
129 
    complexity(roughly the number of nodes) is greater than
130 
    count.  As soon as the complexity exceeds this value it
131 
    stops.  It returns the difference between count and the
2 7u83 132 
    calculated complexity.
133 
*/
134 
 
135 
 
136 
static int complexity
6 7u83 137 
(exp e, int count, int newdecs)
2 7u83 138 
{
6 7u83 139 
  unsigned char n = name(e);
140 
 
2 7u83 141 
  last_new_decs = newdecs;
142 
 
6 7u83 143 
  if (count < 0)
144 
    return(-1);
145 
  if (newdecs > crit_decs)
146 
    return(-2);
147 
  if (son(e) == nilexp)
148 
    return(count);
149 
 
150 
  switch (n) {
151 
    case apply_general_tag:
152 
    case apply_tag: {
153 
     if (newdecs > crit_decsatapp)
154 
       return(-3);
155 
     return(sbl(son(e), (count - apply_cost),
156 
		  (newdecs + 1)));
157 
   }
158 
 
159 
   case rep_tag: {
160 
     return(complexity(bro(son(e)), (count - 1),
161 
#if 0
162 
			 ((newdecs > crit_decsatapp)? newdecs :
163 
			  (crit_decsatapp + 1))
2 7u83 164 
#else
6 7u83 165 
			 (newdecs + 1)
2 7u83 166 
#endif
6 7u83 167 
			 ));
2 7u83 168 
   }
169 
 
6 7u83 170 
   case res_tag: {
171 
     return(complexity(son(e), (count + 1),
172 
			  newdecs));
173 
	}
2 7u83 174 
 
6 7u83 175 
   case ident_tag: {
176 
     return(sbl(son(e), (count - 1),
177 
		  (newdecs + 1)));
2 7u83 178 
   }
179 
 
6 7u83 180 
   case top_tag:
181 
    case clear_tag: {
182 
      return(count);
2 7u83 183 
    }
184 
 
6 7u83 185 
   case case_tag: {
186 
     return(complexity(son(e), (count - 1),
187 
			  newdecs));
2 7u83 188 
   }
189 
 
6 7u83 190 
   case name_tag:
191 
    case string_tag:
192 
     case env_offset_tag: {
193 
       return(count - 1);
2 7u83 194 
     }
195 
 
6 7u83 196 
   case labst_tag: {
197 
     return(complexity(bro(son(e)), count, newdecs));
2 7u83 198 
   }
6 7u83 199 
 
200 
   case solve_tag:
201 
   case seq_tag:
202 
   case cond_tag: {
203 
       return(sbl(son(e), count, newdecs));
2 7u83 204 
     }
205 
 
206 
   default : {
6 7u83 207 
     return(sbl(son(e), (count - 1), newdecs));
2 7u83 208 
   }
209 
  }
210 
    /* NOT REACHED */
211 
}
212 
 
213 
#define MASK 3
6 7u83 214 
#define REJ_ONCE(1)
215 
#define OK_ONCE (2)
216 
 
2 7u83 217 
int inlinechoice
6 7u83 218 
(exp t, exp def, int total_uses)
2 7u83 219 
{
220 
  /* delivers 0 if no uses of this proc can be inlined.
221 
     delivers 1 if this use cannot be inlined
222 
     delivers 2 if this use can be inlined.
223 
     */
224 
  int res;
6 7u83 225 
 
2 7u83 226 
  exp apars;
227 
  exp fpars;
6 7u83 228 
 
2 7u83 229 
  int newdecs = 0;
230 
  int max_complexity;
231 
 
6 7u83 232 
  int nparam;
233 
  CONST unsigned int CONST_BONUS_UNIT = 16;
234 
  int const_param_bonus;
235 
  int adjusted_max_complexity;
2 7u83 236 
  shape shdef = pt(def);
6 7u83 237 
  if (!eq_shape(sh(father(t)),shdef)) {
2 7u83 238 
    return 1;
239 
  }
6 7u83 240 
  nparam = 0;
241 
  const_param_bonus = 0;
2 7u83 242 
  /*
6 7u83 243 
  pr_ident = son(t);
2 7u83 244 
  max_complexity = ( 300 / no ( pr_ident ) ) ;*/
245 
  max_complexity = (crit_inline/total_uses);
246 
  {
247 
#define QQQ 2
248 
    int i;
6 7u83 249 
    if (total_uses >= (1<<QQQ))
2 7u83 250 
    {
6 7u83 251 
      for (i= total_uses >> QQQ; i>0; i >>=1)
2 7u83 252 
      {
253 
	max_complexity *= 3;
254 
	max_complexity /= 2;
255 
      }
256 
    }
257 
#undef QQQ
258 
  }
6 7u83 259 
  if (max_complexity < 15) {
260 
    max_complexity = 15;
261 
  } else if (max_complexity > crit_inline) {
262 
    max_complexity = crit_inline;
2 7u83 263 
  }
264 
 
265 
  apars = bro(t); /* only uses are applications */
6 7u83 266 
  fpars = son(def);
2 7u83 267 
 
6 7u83 268 
  for (;;) {
2 7u83 269 
     if (name(fpars)!=ident_tag || !isparam(fpars)) {
6 7u83 270 
       if (name(apars)!= top_tag)newdecs = 10;
2 7u83 271 
      	 break;
272 
     }
6 7u83 273 
     nparam++;
2 7u83 274 
 
275 
     switch (name(apars)) {
6 7u83 276 
      case val_tag: case real_tag: case string_tag: case name_tag:
2 7u83 277 
       break;
278 
      case cont_tag: {
6 7u83 279 
	if (name(son(apars)) ==name_tag && isvar(son(son(apars))) &&
280 
	    !isvar(fpars))break;
2 7u83 281 
      } /* ... else continue */
282 
       FALL_THROUGH
283 
	default: newdecs++;
284 
     }
6 7u83 285 
     switch (name(apars))
2 7u83 286 
     {
6 7u83 287 
      case val_tag: {
288 
	int n = no(apars);
289 
 
2 7u83 290 
	/* Simple constant param. Increase desire to
291 
	   inline since a constant may cause further
292 
	   optimisation, eg strength reduction (mul
293 
	   to shift) or dead code savings */
294 
 
6 7u83 295 
#define IS_POW2(c)	((c)!= 0 && ((c) & ((c) - 1)) == 0)
296 
 
297 
	if (0) {
2 7u83 298 
	  /* needs a register - poor */
6 7u83 299 
	  const_param_bonus += CONST_BONUS_UNIT / 4;
300 
	} else if (n == 0 || (n > 0 && IS_POW2(n))) {
2 7u83 301 
	  /* very good */
6 7u83 302 
	  const_param_bonus += CONST_BONUS_UNIT;
2 7u83 303 
	} else {
304 
	  /* less good */
6 7u83 305 
	  const_param_bonus += CONST_BONUS_UNIT / 2;
2 7u83 306 
	}
6 7u83 307 
	break;
2 7u83 308 
      }
309 
 
310 
#undef IS_POW2
6 7u83 311 
 
312 
      case real_tag:
2 7u83 313 
	/* reals not that useful */
6 7u83 314 
	const_param_bonus += CONST_BONUS_UNIT / 4;
315 
	break;
2 7u83 316 
 
6 7u83 317 
      case string_tag:
318 
       case name_tag:
319 
	 break;
320 
 
321 
      case cont_tag:
322 
	if (name(son(apars)) == name_tag &&
323 
	    isvar(son(son(apars))) &&
324 
	    !isvar(fpars)) {
325 
	  break;
2 7u83 326 
	}
327 
       FALL_THROUGH
328 
      default : {
6 7u83 329 
	newdecs++;
330 
	break;
2 7u83 331 
      }
332 
     }
333 
     fpars = bro(son(fpars));
6 7u83 334 
     if (last(apars))break;
2 7u83 335 
     apars = bro(apars);
336 
   }
337 
 
6 7u83 338 
  adjusted_max_complexity = max_complexity;
339 
 
2 7u83 340 
  /* increase to up to 3 times (average around 2) according
341 
     to const params */
6 7u83 342 
  if (nparam != 0) {
343 
    adjusted_max_complexity +=
344 
     (2 * max_complexity * const_param_bonus) /
345 
	(CONST_BONUS_UNIT * nparam);
2 7u83 346 
  }
6 7u83 347 
 
2 7u83 348 
  /* increase by number of instructions saved for call */
349 
    adjusted_max_complexity += nparam - newdecs + 1;
6 7u83 350 
 
351 
  if ((complexity(fpars,  adjusted_max_complexity, newdecs)) >= 0)
2 7u83 352 
    res = 2;
353 
  else if (newdecs == 0)
354 
    res = 0;
355 
  else
356 
    res = 1;
357 
 
358 
 
359 
  switch (res)
360 
  {
361 
   case 2:
6 7u83 362 
   (ptno(def)) |= OK_ONCE;
2 7u83 363 
    break;
364 
   case 1:
365 
 
6 7u83 366 
   (ptno(def)) |= REJ_ONCE;
2 7u83 367 
    break;
368 
   case 0:
6 7u83 369 
   ;
2 7u83 370 
  }
371 
 
372 
  return res;
6 7u83 373 
 
2 7u83 374 
}
375