Subversion Repositories tendra.SVN

Rev

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

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