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
    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
6
 
36
 
7
 
37
 
8
    Permission to use, copy, modify, and distribute this software
38
    Permission to use, copy, modify, and distribute this software
9
    and its documentation for any purpose and without fee is hereby
39
    and its documentation for any purpose and without fee is hereby
10
    granted, provided that the above copyright notice appears in all
40
    granted, provided that the above copyright notice appears in all
11
    copies and that both the copyright notice and this permission
41
    copies and that both the copyright notice and this permission
12
    notice appear in supporting documentation.
42
    notice appear in supporting documentation.
13
 
43
 
14
 
44
 
15
    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING
45
    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING
16
    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
46
    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
17
    PARTICULAR PURPOSE.
47
    PARTICULAR PURPOSE.
18
 
48
 
19
 
49
 
20
    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
50
    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
21
    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
51
    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
22
    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
52
    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
23
    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
53
    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
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 85... Line 115...
85
 
115
 
86
#define crit_inline 100
116
#define crit_inline 100
87
#define decs_allowed 4
117
#define decs_allowed 4
88
#define decs_with_apply 0
118
#define decs_with_apply 0
89
 
119
 
90
static int  complexity PROTO_S ((exp, int, int));
120
static int  complexity(exp, int, int);
91
 
121
 
92
static int sbl PROTO_N ((e, count, newdecs)) PROTO_T ( exp e X int count X int newdecs) 
122
static int sbl(exp e, int count, int newdecs)
93
/* applies complexity to the members of a list */
123
/* applies complexity to the members of a list */
94
{
124
{
95
  int  c = complexity (e, count,newdecs);
125
  int  c = complexity(e, count,newdecs);
96
  if (c < 0)
126
  if (c < 0)
97
    return (c);
127
    return(c);
98
  if (last (e))
128
  if (last(e))
99
    return (c);
129
    return(c);
100
  return (sbl (bro (e), c, newdecs));
130
  return(sbl(bro(e), c, newdecs));
101
}
131
}
102
 
132
 
103
static int complexity PROTO_N ((e, count, newdecs)) PROTO_T (exp e X int count X int newdecs)
133
static int complexity(exp e, int count, int newdecs)
104
{
134
{
105
  unsigned char  n = name (e);
135
  unsigned char  n = name(e);
106
  if (count < 0 || newdecs >= decs_allowed)
136
  if (count < 0 || newdecs >= decs_allowed)
107
    return (-1);
137
    return(-1);
108
  if (son(e) == nilexp) return count;
138
  if (son(e) == nilexp) return count;
109
  switch (n) {
139
  switch (n) {
110
  	case apply_tag: {
140
  	case apply_tag: {
111
  	   if (newdecs > decs_with_apply)
141
  	   if (newdecs > decs_with_apply)
112
		 return -1;
142
		 return -1;
113
  	   return(sbl(son(e), count-1, newdecs));
143
  	   return(sbl(son(e), count-1, newdecs));
114
  	}
144
  	}
115
  	case res_tag: return complexity(son(e), count-1, newdecs);
145
  	case res_tag: return complexity(son(e), count-1, newdecs);
116
        case ident_tag:
146
        case ident_tag:
117
	  if (isloadparam(son(e))) 
147
	  if (isloadparam(son(e)))
118
	    return sbl(son(e), count-1, newdecs);
148
	    return sbl(son(e), count-1, newdecs);
119
	  else
149
	  else
120
	    return sbl(son(e), count-1, newdecs+1);
150
	    return sbl(son(e), count-1, newdecs+1);
121
        case top_tag: case clear_tag: case prof_tag: return count;
151
        case top_tag: case clear_tag: case prof_tag: return count;
122
	case case_tag: return (complexity (son (e), count - 1, newdecs));
152
	case case_tag: return(complexity(son(e), count - 1, newdecs));
123
	case name_tag: case string_tag: case env_offset_tag:
153
	case name_tag: case string_tag: case env_offset_tag:
124
               return (count - 1);
154
               return(count - 1);
125
	case labst_tag: return (complexity (bro (son (e)), count,
155
	case labst_tag: return(complexity(bro(son(e)), count,
126
                        newdecs));
156
                        newdecs));
127
	case solve_tag: case seq_tag: return sbl(son(e), count, newdecs);
157
	case solve_tag: case seq_tag: return sbl(son(e), count, newdecs);
128
	default: return (sbl (son (e), count - 1, newdecs));
158
	default: return(sbl(son(e), count - 1, newdecs));
129
  }
159
  }
130
}
160
}
131
 
161
 
132
int inlinechoice PROTO_N ((t, def, total)) PROTO_T (exp t X exp def X int total)
162
int inlinechoice(exp t, exp def, int total)
133
	/* delivers 0 if no uses of this proc can be inlined.
163
	/* delivers 0 if no uses of this proc can be inlined.
134
	   delivers 1 if this use cannot be inlined
164
	   delivers 1 if this use cannot be inlined
135
	   delivers 2 if this use can be inlined.
165
	   delivers 2 if this use can be inlined.
136
	*/
166
	*/
137
{
167
{
138
  exp apars;
168
  exp apars;
139
  exp fpars;
169
  exp fpars;
140
  int newdecs = 0;
170
  int newdecs = 0;
141
  shape shdef = pt(def);
171
  shape shdef = pt(def);
142
  UNUSED (total);
172
  UNUSED(total);
143
  
173
 
144
  if (!eq_shape(sh(father(t)), shdef) ) 
174
  if (!eq_shape(sh(father(t)), shdef))
145
  {
175
  {
146
    /* shape required by application is different from definition */
176
    /* shape required by application is different from definition */
147
    return 1;
177
    return 1;
148
  }
178
  }
149
  apars = t; /* only uses are applications */
179
  apars = t; /* only uses are applications */
150
  fpars = son(def);
180
  fpars = son(def);
151
        	
181
 
152
  for(;;) {
182
  for (;;) {
153
     if (name(fpars)!=ident_tag || !isparam(fpars)) {
183
     if (name(fpars)!=ident_tag || !isparam(fpars)) {
154
	if (!last(apars)) return 1;
184
	if (!last(apars)) return 1;
155
      	break;
185
      	break;
156
     }
186
     }
157
 
187
 
158
     if (last(apars)) return 1;
188
     if (last(apars)) return 1;
159
     apars = bro(apars);
189
     apars = bro(apars);
160
     
190
 
161
     switch (name(apars)) {
191
     switch (name(apars)) {
162
      case val_tag: case real_tag: case string_tag: case name_tag: 
192
      case val_tag: case real_tag: case string_tag: case name_tag:
163
      	   break;
193
      	   break;
164
      case cont_tag: {
194
      case cont_tag: {
165
      	   if (name(son(apars))==name_tag && isvar(son(son(apars))) &&
195
      	   if (name(son(apars)) ==name_tag && isvar(son(son(apars))) &&
166
      	        		!isvar(fpars) ) break;
196
      	        		!isvar(fpars))break;
167
      	   } /* ... else continue */
197
      	   } /* ... else continue */
168
      default: newdecs++;
198
      default: newdecs++;
169
     }
199
     }
170
     fpars = bro(son(fpars));
200
     fpars = bro(son(fpars));
171
  }
201
  }
172
        /* newdecs is now the number of declarations (which will not be
202
        /* newdecs is now the number of declarations (which will not be
173
      	     optimised out) arising from actual parameters */
203
      	     optimised out) arising from actual parameters */
174
 
204
 
175
 
205
 
176
      	     
206
 
177
  if (complexity(fpars, crit_inline, newdecs) >= 0) 
207
  if (complexity(fpars, crit_inline, newdecs) >= 0)
178
    return 2;
208
    return 2;
179
  else if (newdecs == 0)
209
  else if (newdecs == 0)
180
    return 0;
210
    return 0;
181
  return 1;
211
  return 1;
182
}
212
}