Subversion Repositories tendra.SVN

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/* 	$Id: oddtest.c,v 1.1.1.1 1998/01/17 15:56:00 release Exp $	 */
32 
 
33 
#ifndef lint
34 
static char vcid[] = "$Id: oddtest.c,v 1.1.1.1 1998/01/17 15:56:00 release Exp $";
35 
#endif /* lint */
36 
 
37 
/*
38 
   Pattern in oddtest.pat
39 
   this is intended to be the pattern for:
40 
   if (test) fexp 1 else fexp -1
41 
   to transform to:
42 
   fexp ( (absbool(test) <<1) -1))
43 
   where f is any sequence of unary operators including identity
44 
*/
45 
 
46 
/*
47 
$Log: oddtest.c,v $
48 
 * Revision 1.1.1.1  1998/01/17  15:56:00  release
49 
 * First version to be checked into rolling release.
50 
 *
51 
 * Revision 1.1.1.1  1995/03/23  10:39:15  john
52 
 * Entered into CVS
53 
 *
54 
 * Revision 1.3  1995/01/26  13:45:30  john
55 
 * Removed unused label
56 
 *
57 
*/
58 
 
59 
#include "config.h"
60 
#include "tags.h"
61 
#include "common_types.h"
62 
#include "expmacs.h"
63 
#include "exptypes.h"
64 
#include "shapemacs.h"
65 
#include "comp_eq_exp.h"
66 
#include "check.h"
67 
#include "oddtest.h"
68 
 
69 
static int oddunary
70 
    PROTO_N ( ( x, y, v ) )
71 
    PROTO_T ( exp x X exp y X exp *v )
72 
{
73 
  exp z;
74 
  *v = x;
75 
  if (name(x) != val_tag) goto flab1;
76 
  if (!(name(y)==val_tag && ((no(x)==1 && no(y)==-1) || (no(x)==-1 && no(y)==1) ))) goto flab1;
77 
  goto tlab1;
78 
 flab1:
79 
  if (!(name(x)==name(y))) goto flab0;
80 
  { exp xC = son(x);
81 
    z = xC;
82 
    if (!(z!=nilexp && last(z) && son(y) != nilexp && oddunary(z, son(y),v))) goto flab0;
83 
    if(!last(xC)) goto flab0;
84 
  }
85 
 tlab1:
86 
  return 1;
87 
 flab0: return 0;
88 
}
89 
 
90 
int oddtest
91 
    PROTO_N ( ( x, t, f, v ) )
92 
    PROTO_T ( exp x X exp *t X exp *f X exp *v )
93 
{
94 
  exp l, z, g;
95 
  if (name(x) != cond_tag) goto flab0;
96 
  { exp xC = son(x);
97 
    if (name(xC) != seq_tag) goto flab0;
98 
    { exp xCC = son(xC);
99 
      { exp xCCC = son(xCC);
100 
        *t = xCCC;
101 
        if (name(xCCC) != test_tag) goto flab0;
102 
        l =pt(*t);
103 
        if(!last(xCCC)) goto flab0;
104 
      }
105 
      if (last(xCC)) goto flab0;
106 
      xCC = bro(xCC);
107 
      *f = xCC;
108 
      if(!last(xCC)) goto flab0;
109 
    }
110 
    if (last(xC)) goto flab0;
111 
    xC = bro(xC);
112 
    if (l != xC) goto flab0;
113 
    { exp xCC = son(xC);
114 
      z = xCC;
115 
      if (!(no(z)==1)) goto flab0;
116 
      if (last(xCC)) goto flab0;
117 
      xCC = bro(xCC);
118 
      g = xCC;
119 
      if (!(oddunary(*f,g,v))) goto flab0;
120 
      if(!last(xCC)) goto flab0;
121 
    }
122 
    if(!last(xC)) goto flab0;
123 
  }
124 
  return 1;
125 
  flab0: return 0;
126 
}
127 
 
128 
/* last_statement finds the last obeyed statement of x and puts it in f */
129 
int last_statement
130 
    PROTO_N ( ( x, f ) )
131 
    PROTO_T ( exp x X exp *f )
132 
{
133 
  exp z;
134 
  if (name(x) != ident_tag) goto flab1;
135 
  { exp xC = son(x);
136 
    if (last(xC)) goto flab1;
137 
    xC = bro(xC);
138 
    z = xC;
139 
    last_statement(z, f);
140 
    if(!last(xC)) goto flab1;
141 
  }
142 
  goto tlab1;
143 
  flab1:
144 
  if (name(x) != seq_tag) goto flab2;
145 
  { exp xC = son(x);
146 
    if (last(xC)) goto flab2;
147 
    xC = bro(xC);
148 
    z = xC;
149 
    last_statement(z, f);
150 
    if(!last(xC)) goto flab2;
151 
  }
152 
  goto tlab1;
153 
  flab2:
154 
  z = x;
155 
   *f = z;
156 
  tlab1:
157 
  return 1;
158 
}
159 
 
160 
 
161 
int is_maxlike
162 
    PROTO_N ( ( x, t ) )
163 
    PROTO_T ( exp x X exp *t )
164 
{
165 
  exp op1, op2, z, l, w;
166 
  if (name(x) != cond_tag) goto flab0;
167 
  { exp xC = son(x);
168 
    if (name(xC) != seq_tag) goto flab0;
169 
    { exp xCC = son(xC);
170 
      { exp xCCC = son(xCC);
171 
        *t = xCCC;
172 
        if (name(xCCC) != test_tag) goto flab0;
173 
        l=pt(*t);
174 
        { exp xCCCC = son(xCCC);
175 
          op1 = xCCCC;
176 
          if (!(!is_floating(name(sh(op1))))) goto flab0;
177 
          if (last(xCCCC)) goto flab0;
178 
          xCCCC = bro(xCCCC);
179 
          op2 = xCCCC;
180 
          if(!last(xCCCC)) goto flab0;
181 
        }
182 
        if(!last(xCCC)) goto flab0;
183 
      }
184 
      if (last(xCC)) goto flab0;
185 
      xCC = bro(xCC);
186 
      z = xCC;
187 
      if (!(comp_eq_exp(z, op1, nilexp,nilexp))) goto flab0;
188 
      if(!last(xCC)) goto flab0;
189 
    }
190 
    if (last(xC)) goto flab0;
191 
    xC = bro(xC);
192 
    if (l != xC) goto flab0;
193 
    { exp xCC = son(xC);
194 
      z = xCC;
195 
      if (!(no(z)==1)) goto flab0;
196 
      if (last(xCC)) goto flab0;
197 
      xCC = bro(xCC);
198 
      w = xCC;
199 
      if (!(comp_eq_exp(w, op2,nilexp,nilexp))) goto flab0;
200 
      if(!last(xCC)) goto flab0;
201 
    }
202 
    if(!last(xC)) goto flab0;
203 
  }
204 
  return 1;
205 
  flab0: return 0;
206 
}
207 
 
208 
 
209 
int is_minlike
210 
    PROTO_N ( ( x, t ) )
211 
    PROTO_T ( exp x X exp *t )
212 
{
213 
  exp op1, op2, z, l, w;
214 
  if (name(x) != cond_tag) goto flab0;
215 
  { exp xC = son(x);
216 
    if (name(xC) != seq_tag) goto flab0;
217 
    { exp xCC = son(xC);
218 
      { exp xCCC = son(xCC);
219 
        *t = xCCC;
220 
        if (name(xCCC) != test_tag) goto flab0;
221 
        l=pt(*t);
222 
        { exp xCCCC = son(xCCC);
223 
          op1 = xCCCC;
224 
          if (!(!is_floating(name(sh(op1))))) goto flab0;
225 
          if (last(xCCCC)) goto flab0;
226 
          xCCCC = bro(xCCCC);
227 
          op2 = xCCCC;
228 
          if(!last(xCCCC)) goto flab0;
229 
        }
230 
        if(!last(xCCC)) goto flab0;
231 
      }
232 
      if (last(xCC)) goto flab0;
233 
      xCC = bro(xCC);
234 
      z = xCC;
235 
      if (!(comp_eq_exp(z, op2,nilexp,nilexp))) goto flab0;
236 
      if(!last(xCC)) goto flab0;
237 
    }
238 
    if (last(xC)) goto flab0;
239 
    xC = bro(xC);
240 
    if (l != xC) goto flab0;
241 
    { exp xCC = son(xC);
242 
      z = xCC;
243 
      if (!(no(z)==1)) goto flab0;
244 
      if (last(xCC)) goto flab0;
245 
      xCC = bro(xCC);
246 
      w = xCC;
247 
      if (!(comp_eq_exp(w, op1,nilexp,nilexp))) goto flab0;
248 
      if(!last(xCC)) goto flab0;
249 
    }
250 
    if(!last(xC)) goto flab0;
251 
  }
252 
  return 1;
253 
  flab0: return 0;
254 
}
255 
 
256 
/* looks for things like
257 
	(a~0) ? a:-a
258 
*/
259 
int is_abslike
260 
    PROTO_N ( ( x,t ) )
261 
    PROTO_T ( exp x X exp *t )
262 
{
263 
  exp op, l, z, w;
264 
  if (name(x) != cond_tag) goto flab0;
265 
  { exp xC = son(x);
266 
    if (name(xC) != seq_tag) goto flab0;
267 
    { exp xCC = son(xC);
268 
      { exp xCCC = son(xCC);
269 
        *t = xCCC;
270 
        if (name(xCCC) != test_tag) goto flab0;
271 
        l=pt(*t);
272 
        { exp xCCCC = son(xCCC);
273 
          op = xCCCC;
274 
          if (last(xCCCC)) goto flab0;
275 
          xCCCC = bro(xCCCC);
276 
          if (name(xCCCC) != val_tag || no(xCCCC) != 0) goto flab0;
277 
          if(!last(xCCCC)) goto flab0;
278 
        }
279 
        if(!last(xCCC)) goto flab0;
280 
      }
281 
      if (last(xCC)) goto flab0;
282 
      xCC = bro(xCC);
283 
      z = xCC;
284 
      if (!(comp_eq_exp(z, op,nilexp,nilexp))) goto flab0;
285 
      if(!last(xCC)) goto flab0;
286 
    }
287 
    if (last(xC)) goto flab0;
288 
    xC = bro(xC);
289 
    if (l != xC) goto flab0;
290 
    { exp xCC = son(xC);
291 
      z = xCC;
292 
      if (!(no(z)==1)) goto flab0;
293 
      if (last(xCC)) goto flab0;
294 
      xCC = bro(xCC);
295 
      if (name(xCC) != neg_tag) goto flab0;
296 
      { exp xCCC = son(xCC);
297 
        w = xCCC;
298 
        if (!(comp_eq_exp(op, w,nilexp,nilexp))) goto flab0;
299 
        if(!last(xCCC)) goto flab0;
300 
      }
301 
      if(!last(xCC)) goto flab0;
302 
    }
303 
    if(!last(xC)) goto flab0;
304 
  }
305 
  return 1;
306 
  flab0: return 0;
307 
}
308 
 
309 
 
310 
 
311 
int is_fabs
312 
    PROTO_N ( ( x, t ) )
313 
    PROTO_T ( exp x X exp *t )
314 
{
315 
  exp op, l, z, w;
316 
  if (name(x) != cond_tag) goto flab0;
317 
  { exp xC = son(x);
318 
    if (name(xC) != seq_tag) goto flab0;
319 
    { exp xCC = son(xC);
320 
      { exp xCCC = son(xCC);
321 
        *t = xCCC;
322 
        if (name(xCCC) != test_tag) goto flab0;
323 
        l=pt(*t);
324 
        { exp xCCCC = son(xCCC);
325 
          op = xCCCC;
326 
          if (last(xCCCC)) goto flab0;
327 
          xCCCC = bro(xCCCC);
328 
          if (name(xCCCC) != val_tag || no(xCCCC) != 0) goto flab0;
329 
          if(!last(xCCCC)) goto flab0;
330 
        }
331 
        if(!last(xCCC)) goto flab0;
332 
      }
333 
      if (last(xCC)) goto flab0;
334 
      xCC = bro(xCC);
335 
      z = xCC;
336 
      if (!(eq_exp(z, op))) goto flab0;
337 
      if(!last(xCC)) goto flab0;
338 
    }
339 
    if (last(xC)) goto flab0;
340 
    xC = bro(xC);
341 
    if (l != xC) goto flab0;
342 
    { exp xCC = son(xC);
343 
      z = xCC;
344 
      if (!(no(z)==1)) goto flab0;
345 
      if (last(xCC)) goto flab0;
346 
      xCC = bro(xCC);
347 
      if (name(xCC) != fneg_tag) goto flab0;
348 
      { exp xCCC = son(xCC);
349 
        w = xCCC;
350 
        if (!(eq_exp(op, w))) goto flab0;
351 
        if(!last(xCCC)) goto flab0;
352 
      }
353 
      if(!last(xCC)) goto flab0;
354 
    }
355 
    if(!last(xC)) goto flab0;
356 
  }
357 
  return 1;
358 
  flab0: return 0;
359 
}
360