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
*/
Line 50... Line 80...
50
 * Revision 3.4  1995/08/25  09:39:31  wfs
80
 * Revision 3.4  1995/08/25  09:39:31  wfs
51
 * A 4.0 "general_env_offset_tag" case added.
81
 * A 4.0 "general_env_offset_tag" case added.
52
 *
82
 *
53
 * Revision 3.1  95/04/10  16:26:51  16:26:51  wfs (William Simmonds)
83
 * Revision 3.1  95/04/10  16:26:51  16:26:51  wfs (William Simmonds)
54
 * Apr95 tape version.
84
 * Apr95 tape version.
55
 * 
85
 *
56
 * Revision 3.0  95/03/30  11:17:28  11:17:28  wfs (William Simmonds)
86
 * Revision 3.0  95/03/30  11:17:28  11:17:28  wfs (William Simmonds)
57
 * Mar95 tape version with CRCR95_178 bug fix.
87
 * Mar95 tape version with CRCR95_178 bug fix.
58
 * 
88
 *
59
 * Revision 2.0  95/03/15  15:27:35  15:27:35  wfs (William Simmonds)
89
 * Revision 2.0  95/03/15  15:27:35  15:27:35  wfs (William Simmonds)
60
 * spec 3.1 changes implemented, tests outstanding.
90
 * spec 3.1 changes implemented, tests outstanding.
61
 * 
91
 *
62
 * Revision 1.1  95/01/11  13:09:12  13:09:12  wfs (William Simmonds)
92
 * Revision 1.1  95/01/11  13:09:12  13:09:12  wfs (William Simmonds)
63
 * Initial revision
93
 * Initial revision
64
 * 
94
 *
65
*/
95
*/
66
 
96
 
67
 
97
 
68
#include "config.h"
98
#include "config.h"
69
#include "common_types.h"
99
#include "common_types.h"
70
#include "installglob.h"
100
#include "installglob.h"
71
#include "exp.h"
101
#include "exp.h"
Line 78... Line 108...
78
#define crit_inline	300
108
#define crit_inline	300
79
#define crit_decs	5
109
#define crit_decs	5
80
#define crit_decsatapp	5
110
#define crit_decsatapp	5
81
#define apply_cost      3
111
#define apply_cost      3
82
 
112
 
83
static int  complexity PROTO_S ((exp e, int count, int newdecs));
113
static int  complexity(exp e, int count, int newdecs);
84
static last_new_decs = -999;
114
static last_new_decs = -999;
85
 
115
 
86
/*
116
/*
87
    APPLY COMPLEXITY TO A LIST OF EXPRESSIONS
117
    APPLY COMPLEXITY TO A LIST OF EXPRESSIONS
88
*/
118
*/
89
 
119
 
90
int sbl 
120
int sbl
91
    PROTO_N ( ( e, count, newdecs ) )
-
 
92
    PROTO_T ( exp e X int count X int newdecs )
121
(exp e, int count, int newdecs)
93
{
122
{
94
    int c = complexity ( e, count, newdecs ) ;
123
    int c = complexity(e, count, newdecs);
95
    if ( c < 0 ) return ( c ) ;
124
    if (c < 0) return(c);
96
    if ( last ( e ) ) return ( c ) ;
125
    if (last(e)) return(c);
97
    return ( sbl ( bro ( e ), c, newdecs ) ) ;
126
    return(sbl(bro(e), c, newdecs));
98
}
127
}
99
 
128
 
100
 
129
 
101
/*
130
/*
102
    FIND THE COMPLEXITY OF AN EXPRESSION
131
    FIND THE COMPLEXITY OF AN EXPRESSION
Line 105... Line 134...
105
    (roughly the number of nodes) is greater than count.  As soon as the
134
    (roughly the number of nodes) is greater than count.  As soon as the
106
    complexity exceeds this value it stops.  It returns the difference
135
    complexity exceeds this value it stops.  It returns the difference
107
    between count and the calculated complexity.
136
    between count and the calculated complexity.
108
*/
137
*/
109
 
138
 
110
static int complexity 
139
static int complexity
111
    PROTO_N ( ( e, count, newdecs ) )
-
 
112
    PROTO_T ( exp e X int count X int newdecs )
140
(exp e, int count, int newdecs)
113
{
141
{
114
    unsigned char n = name ( e ) ;
142
    unsigned char n = name(e);
115
    
143
 
116
    last_new_decs = newdecs;
144
    last_new_decs = newdecs;
117
    
145
 
118
    if ( count < 0 )
146
    if (count < 0)
119
      return ( -1 ) ;
147
      return(-1);
120
    if (newdecs > crit_decs )
148
    if (newdecs > crit_decs)
121
      return ( -2);
149
      return(-2);
122
    if ( son ( e ) == nilexp ) 
150
    if (son(e) == nilexp)
123
      return ( count ) ;
151
      return(count);
124
 
152
 
125
    switch ( n ) {
153
    switch (n) {
126
 
154
 
127
	case apply_tag : {
155
	case apply_tag: {
128
	    if ( newdecs > crit_decsatapp ) 
156
	    if (newdecs > crit_decsatapp)
129
	      return ( -3 ) ;
157
	      return(-3);
130
	    return ( sbl ( son ( e ),  ( count - apply_cost ),
158
	    return(sbl(son(e), (count - apply_cost),
131
			  ( newdecs + 1 ) ) ) ;
159
			 (newdecs + 1)));
132
	}
160
	}
133
 
161
 
134
	case rep_tag : {
162
	case rep_tag: {
135
	    return ( complexity ( bro ( son ( e ) ),  ( count - 1 ),
163
	    return(complexity(bro(son(e)), (count - 1),
136
		      (newdecs + 1)
164
		     (newdecs + 1)
137
				 ));
165
				));
-
 
166
	}
-
 
167
 
-
 
168
	case res_tag: {
-
 
169
	    return(complexity(son(e), (count + 1),
-
 
170
				  newdecs));
-
 
171
	}
-
 
172
 
-
 
173
	case ident_tag: {
-
 
174
	    return(sbl(son(e), (count - 1),
-
 
175
			   (newdecs + 1)));
138
	}
176
	}
139
 
177
 
140
	case res_tag : {
178
	case top_tag:
141
	    return ( complexity ( son ( e ),  ( count + 1 ),
-
 
142
				  newdecs ) ) ;
179
	case clear_tag:
143
	}
-
 
144
 
-
 
145
	case ident_tag : {
180
	case val_tag: {
146
	    return ( sbl ( son ( e ),  ( count - 1 ),
-
 
147
			    ( newdecs + 1 ) ) ) ;
181
	    return(count);
148
	}
182
	}
149
 
183
 
150
	case top_tag :
-
 
151
	case clear_tag :
184
	case case_tag: {
152
	case val_tag : {
185
	    return(complexity(son(e), (count - 1),
153
	    return ( count ) ;
186
				  newdecs));
154
	}
187
	}
155
 
188
 
156
	case case_tag : {
-
 
157
	    return ( complexity ( son ( e ),  ( count - 1 ),
-
 
158
				  newdecs ) ) ;
-
 
159
	}
-
 
160
 
-
 
161
	case name_tag :
189
	case name_tag:
162
	case string_tag :
190
	case string_tag:
163
	case env_offset_tag :
191
	case env_offset_tag:
164
	case general_env_offset_tag:
192
	case general_env_offset_tag:
165
	{
193
	{
166
	    return ( count - 1 ) ;
194
	    return(count - 1);
167
	}
-
 
168
 
-
 
169
	case labst_tag : {
-
 
170
	    return ( complexity ( bro ( son ( e ) ), count, newdecs ) ) ;
-
 
171
	}
195
	}
172
 
196
 
-
 
197
	case labst_tag: {
-
 
198
	    return(complexity(bro(son(e)), count, newdecs));
-
 
199
	}
-
 
200
 
173
	case solve_tag :
201
	case solve_tag:
174
	case seq_tag :
202
	case seq_tag:
175
	case cond_tag : {
203
	case cond_tag: {
176
	    return ( sbl ( son ( e ), count, newdecs ) ) ;
204
	    return(sbl(son(e), count, newdecs));
177
	}
205
	}
178
 
206
 
179
	default : {
207
	default : {
180
	    return ( sbl ( son ( e ),  ( count - 1 ), newdecs ) ) ;
208
	    return(sbl(son(e), (count - 1), newdecs));
181
	}
209
	}
182
    }
210
    }
183
    /* NOT REACHED */
211
    /* NOT REACHED */
184
}
212
}
185
 
213
 
186
#define MASK 3
214
#define MASK 3
187
#define REJ_ONCE (1)
215
#define REJ_ONCE(1)
188
#define OK_ONCE  (2)
216
#define OK_ONCE (2)
189
	
217
 
190
 
218
 
191
int inlinechoice
219
int inlinechoice
192
    PROTO_N ( ( t, def, total_uses ) )
-
 
193
    PROTO_T ( exp t X exp def X int total_uses )
220
(exp t, exp def, int total_uses)
194
	/* delivers 0 if no uses of this proc can be inlined.
221
	/* delivers 0 if no uses of this proc can be inlined.
195
	   delivers 1 if this use cannot be inlined
222
	   delivers 1 if this use cannot be inlined
196
	   delivers 2 if this use can be inlined.
223
	   delivers 2 if this use can be inlined.
197
	*/
224
	*/
198
{
225
{
199
  int res;
226
  int res;
200
  
227
 
201
  exp apars;
228
  exp apars;
202
  exp fpars;
229
  exp fpars;
203
  
230
 
204
  int newdecs = 0;
231
  int newdecs = 0;
205
 
232
 
206
  int max_complexity;
233
  int max_complexity;
207
 
234
 
208
  int nparam ;
235
  int nparam;
209
  CONST unsigned int CONST_BONUS_UNIT = 16 ;
236
  CONST unsigned int CONST_BONUS_UNIT = 16;
210
  int const_param_bonus ;
237
  int const_param_bonus;
211
  int adjusted_max_complexity ;
238
  int adjusted_max_complexity;
212
 
239
 
213
#if 1
240
#if 1
214
  shape shdef = pt(def);
241
  shape shdef = pt(def);
215
  if (!eq_shape(sh(father(t)), shdef) ) 
242
  if (!eq_shape(sh(father(t)), shdef))
216
  {
243
  {
217
    /* shape required by application is different from definition */
244
    /* shape required by application is different from definition */
218
    return 1;
245
    return 1;
219
  }
246
  }
220
#endif
247
#endif
221
    
-
 
222
  nparam = 0 ;
-
 
223
  const_param_bonus = 0 ;
-
 
224
  
-
 
225
 
248
 
-
 
249
  nparam = 0;
226
  max_complexity = ( crit_inline / total_uses ) ;
250
  const_param_bonus = 0;
227
 
251
 
228
 
252
 
-
 
253
  max_complexity = (crit_inline / total_uses);
229
 
254
 
-
 
255
 
-
 
256
 
230
#if ishppa  
257
#if ishppa
231
  {
258
  {
232
#define QQQ 2
259
#define QQQ 2
233
    int i;
260
    int i;
234
    if (total_uses >=(1<<QQQ))
261
    if (total_uses >= (1<<QQQ))
235
    {
262
    {
236
      for (i= total_uses >> QQQ ; i>0; i >>=1)
263
      for (i= total_uses >> QQQ; i>0; i >>=1)
237
      {
264
      {
238
	max_complexity *= 3;
265
	max_complexity *= 3;
239
	max_complexity /= 2;
266
	max_complexity /= 2;
240
      }
267
      }
241
    }
268
    }
242
#undef QQQ
269
#undef QQQ
243
  }
270
  }
244
#endif
271
#endif
245
   
272
 
246
  if ( max_complexity < 15 ) {
273
  if (max_complexity < 15) {
247
    max_complexity = 15 ;
274
    max_complexity = 15;
248
  } else if ( max_complexity > 120 ) {
275
  } else if (max_complexity > 120) {
249
    max_complexity = 120 ;
276
    max_complexity = 120;
250
  }
277
  }
251
 
278
 
252
  apars = bro(t); /* only uses are applications */
279
  apars = bro(t); /* only uses are applications */
253
  fpars = son(def);      	
280
  fpars = son(def);
254
 
281
 
255
  for(;;) {
282
  for (;;) {
256
     if (name(fpars)!=ident_tag || !isparam(fpars)) {
283
     if (name(fpars)!=ident_tag || !isparam(fpars)) {
257
       if (name(apars) != top_tag) newdecs = 10;
284
       if (name(apars)!= top_tag)newdecs = 10;
258
      	 break;
285
      	 break;
259
     }
286
     }
260
     nparam++ ;
287
     nparam++;
261
 
288
 
262
     switch (name(apars)) {
289
     switch (name(apars)) {
263
      case val_tag: case real_tag: case string_tag: case name_tag: 
290
      case val_tag: case real_tag: case string_tag: case name_tag:
264
      	   break;
291
      	   break;
265
      case cont_tag: {
292
      case cont_tag: {
266
      	   if (name(son(apars))==name_tag && isvar(son(son(apars))) &&
293
      	   if (name(son(apars)) ==name_tag && isvar(son(son(apars))) &&
267
      	        		!isvar(fpars) ) break;
294
      	        		!isvar(fpars))break;
268
      	   } /* ... else continue */
295
      	   } /* ... else continue */
269
      default: newdecs++;
296
      default: newdecs++;
270
     }
297
     }
271
     switch ( name ( apars ) ) 
298
     switch (name(apars))
272
     {
299
     {
273
      case val_tag : {
300
      case val_tag: {
274
	int n = no ( apars ) ;
301
	int n = no(apars);
275
	
302
 
276
	/* Simple constant param. Increase desire to
303
	/* Simple constant param. Increase desire to
277
	   inline since a constant may cause further
304
	   inline since a constant may cause further
278
	   optimisation, eg strength reduction (mul
305
	   optimisation, eg strength reduction (mul
279
	   to shift) or dead code savings */
306
	   to shift) or dead code savings */
280
 
307
 
281
#define IS_POW2( c )	( ( c ) != 0 && ( ( c ) & ( ( c ) - 1 ) ) == 0 )
308
#define IS_POW2(c)	((c)!= 0 && ((c) & ((c) - 1)) == 0)
282
	
309
 
283
	if ( 0 ) {
310
	if (0) {
284
	  /* needs a register - poor */
311
	  /* needs a register - poor */
285
	  const_param_bonus += CONST_BONUS_UNIT / 4 ;
312
	  const_param_bonus += CONST_BONUS_UNIT / 4;
286
	} else if ( n == 0 || ( n > 0 && IS_POW2 ( n ) ) ) {
313
	} else if (n == 0 || (n > 0 && IS_POW2(n))) {
287
	  /* very good */
314
	  /* very good */
288
	  const_param_bonus += CONST_BONUS_UNIT ;
315
	  const_param_bonus += CONST_BONUS_UNIT;
289
	} else {
316
	} else {
290
	  /* less good */
317
	  /* less good */
291
	  const_param_bonus += CONST_BONUS_UNIT / 2 ;
318
	  const_param_bonus += CONST_BONUS_UNIT / 2;
292
	}
319
	}
293
	break ;
320
	break;
294
      }
321
      }
295
 
322
 
296
#undef IS_POW2
323
#undef IS_POW2
297
       
-
 
298
      case real_tag : 
-
 
299
	/* reals not that useful */
-
 
300
	const_param_bonus += CONST_BONUS_UNIT / 4 ;
-
 
301
	break ;
-
 
302
       
-
 
303
      case string_tag :
-
 
304
       case name_tag : 
-
 
305
	 break ;
-
 
306
 
324
 
-
 
325
      case real_tag:
-
 
326
	/* reals not that useful */
-
 
327
	const_param_bonus += CONST_BONUS_UNIT / 4;
-
 
328
	break;
-
 
329
 
-
 
330
      case string_tag:
-
 
331
       case name_tag:
-
 
332
	 break;
-
 
333
 
307
      case cont_tag : 
334
      case cont_tag:
308
	if ( name ( son ( apars ) ) == name_tag &&
335
	if (name(son(apars)) == name_tag &&
309
	    isvar ( son ( son ( apars ) ) ) &&
336
	    isvar(son(son(apars))) &&
310
	    !isvar ( fpars ) ) {
337
	    !isvar(fpars)) {
311
	  break ;
338
	  break;
312
	}
339
	}
313
	/* FALL THROUGH */
340
	/* FALL THROUGH */
314
       
341
 
315
      default : {
342
      default : {
316
	newdecs++ ;
343
	newdecs++;
317
	break ;
344
	break;
318
      }
345
      }
319
     }
346
     }
320
     fpars = bro(son(fpars));
347
     fpars = bro(son(fpars));
321
     if (last(apars)) break;
348
     if (last(apars))break;
322
     apars = bro(apars);
349
     apars = bro(apars);
323
   }
350
   }
324
 
351
 
325
  adjusted_max_complexity = max_complexity ;
352
  adjusted_max_complexity = max_complexity;
326
  
353
 
327
  /* increase to up to 3 times (average around 2) according
354
  /* increase to up to 3 times (average around 2) according
328
     to const params */
355
     to const params */
329
  if ( nparam != 0 ) {
356
  if (nparam != 0) {
330
    adjusted_max_complexity += 
357
    adjusted_max_complexity +=
331
      ( 2 * max_complexity * const_param_bonus ) /
358
     (2 * max_complexity * const_param_bonus) /
332
	( CONST_BONUS_UNIT * nparam ) ;
359
	(CONST_BONUS_UNIT * nparam);
333
  }
360
  }
334
    
361
 
335
  /* increase by number of instructions saved for call */
362
  /* increase by number of instructions saved for call */
336
    adjusted_max_complexity += nparam - newdecs + 1 ;
363
    adjusted_max_complexity += nparam - newdecs + 1;
337
  
364
 
338
  if ( (complexity ( fpars,  adjusted_max_complexity, newdecs )) >= 0 )
365
  if ((complexity(fpars,  adjusted_max_complexity, newdecs)) >= 0)
339
    res = 2;
366
    res = 2;
340
  else if (newdecs == 0)
367
  else if (newdecs == 0)
341
    res = 0;
368
    res = 0;
342
  else
369
  else
343
    res = 1;
370
    res = 1;
344
 
371
 
345
 
372
 
346
  switch (res)
373
  switch (res)
347
  {
374
  {
348
   case 2:
375
   case 2:
349
    (ptno(def)) |= OK_ONCE;
376
   (ptno(def)) |= OK_ONCE;
350
    break;
377
    break;
351
   case 1:
378
   case 1:
352
 
379
 
353
    (ptno(def)) |= REJ_ONCE;
380
   (ptno(def)) |= REJ_ONCE;
354
    break;
381
    break;
355
   case 0:
382
   case 0:
356
    ;
383
   ;
357
  }
384
  }
358
 
385
 
359
  return res;
386
  return res;
360
  
387
 
361
}
388
}
362
 
389