Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 243

Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 247

Warning: Undefined variable $m in /usr/local/www/websvn.planix.org/include/diff_util.php on line 251
WebSVN – tendra.SVN – Diff – /trunk/src/installers/common/construct/misc_c.c – Rev 2 and 7

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-2006 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
Line 38... Line 68...
38 
 *
 68 
 *
39 
 * Revision 1.1  1995/04/06  10:44:05  currie
 69 
 * Revision 1.1  1995/04/06  10:44:05  currie
40 
 * Initial revision
 70 
 * Initial revision
41 
 *
 71 
 *
42 
***********************************************************************/
 72 
***********************************************************************/
43 
 
 - 
 
44 
 
 - 
 
45 
 
 - 
 
46 
 
 73 
 
47 
#include "config.h"
 74 
#include "config.h"
48 
#include "common_types.h"
 75 
#include "common_types.h"
49 
#include "exp.h"
 76 
#include "exp.h"
50 
#include "expmacs.h"
 77 
#include "expmacs.h"
Line 53... Line 80...
53 
#include "shapemacs.h"
 80 
#include "shapemacs.h"
54 
#include "complex_eq.h"
 81 
#include "complex_eq.h"
55 
 
 82 
 
56 
#include "misc_c.h"
 83 
#include "misc_c.h"
57 
 
 84 
 
58 
static int invar_list
 85 
static int
59 
    PROTO_N ( (e) )
 - 
 
60 
    PROTO_T ( exp e )
 86 
invar_list(exp e)
61 
{
 87 
{
62 
  while (1) {
 88 
	while (1) {
63 
    if (e==nilexp)
 89 
		if (e==nilexp) {
64 
      return 1;
 90 
			return 1;
- 
 
 91 
		}
65 
    if (!invariant_to_apply(e))
 92 
		if (!invariant_to_apply(e)) {
66 
      return 0;
 93 
			return 0;
- 
 
 94 
		}
67 
    if (last(e))
 95 
		if (last(e)) {
68 
      return 1;
 96 
			return 1;
- 
 
 97 
		}
69 
    e = bro(e);
 98 
		e = bro(e);
70 
  };
 99 
	}
71 
}
 100 
}
- 
 
 101 
 
72 
 
 102 
 
73 
/* determines if e has no side effects and the same value
 103 
/* determines if e has no side effects and the same value
74 
   if evaluated immediately before and after any procedure
 104 
   if evaluated immediately before and after any procedure
75 
   call (including a recursive one). The evaluation of the
 105 
   call (including a recursive one). The evaluation of the
76 
   procedure arguments is assumed to to affect the value of e.
 106 
   procedure arguments is assumed to to affect the value of e.
77 
   e will not be nilexp.
 107 
   e will not be nilexp.
175 
 
 217 
 
176 
int take_out_by_prob
 218 
/* looks for things like
177 
    PROTO_N ( (first, alt) )
 219 
	(a ~ b) ? a : b
- 
 
 220 
	puts test in t - can make use of delay-slot
- 
 
 221 
*/
- 
 
 222 
int
178 
    PROTO_T ( exp first X exp alt )
 223 
is_maxop(exp x, exp *t)
179 
{
 224 
{
180 
  int extract = 0;
 - 
 
181 
  if (!extract &&
 - 
 
182 
		    name(first) == seq_tag &&
 - 
 
183 
		    no(son(alt)) == 1 &&
 - 
 
184 
		    (is_tester(son(son(first)), 0) &&
 - 
 
185 
		      pt(son(son(first))) == alt &&
 - 
 
186 
			no(son(son(first))) < 29))
 - 
 
187 
	    extract = 1;
 225 
	exp op1, op2, z, l, w;
188 
  if (!extract &&
 - 
 
189 
		    name(first) == seq_tag &&
 226 
	if (name(x) != cond_tag) {
190 
		    no(son(alt)) == 1 &&
 - 
 
191 
		    name(son(son(first))) == ident_tag &&
 - 
 
192 
		    is_tester(bro(son(son(son(first)))), 0) &&
 - 
 
193 
		    pt(bro(son(son(son(first))))) == alt &&
 - 
 
194 
		    no(bro(son(son(son(first))))) < 29)
 - 
 
195 
	    extract = 1;
 - 
 
196 
  return extract;
 227 
		goto flab0;
197 
}
 228 
	}
198 
/* looks for things like
 - 
 
199 
	(a ~ b) ? a: b
 - 
 
200 
	puts test in t - can make use of delay-slot
 - 
 
201 
*/
 229 
	{
202 
int is_maxop
 230 
		exp xC = son(x);
203 
    PROTO_N ( (x, t) )
 231 
		if (name(xC) != seq_tag) {
204 
    PROTO_T ( exp x X exp *t )
 232 
			goto flab0;
- 
 
 233 
		}
205 
{
 234 
		{
206 
  exp op1, op2, z, l, w;
 - 
 
207 
  if (name(x) != cond_tag) goto flab0;
 - 
 
208 
  { exp xC = son(x);
 235 
			exp xCC = son(xC);
209 
    if (name(xC) != seq_tag) goto flab0;
 - 
 
210 
    { exp xCC = son(xC);
 236 
			{
211 
      { exp xCCC = son(xCC);
 237 
				exp xCCC = son(xCC);
212 
        *t = xCCC;
 238 
				*t = xCCC;
213 
        if (name(xCCC) != test_tag) goto flab0;
 239 
				if (name(xCCC) != test_tag) {
- 
 
 240 
					goto flab0;
- 
 
 241 
				}
214 
        l=pt(*t);
 242 
				l=pt(*t);
- 
 
 243 
				{
215 
        { exp xCCCC = son(xCCC);
 244 
					exp xCCCC = son(xCCC);
216 
          op1 = xCCCC;
 245 
					op1 = xCCCC;
217 
          if (!(!is_floating(name(sh(op1))))) goto flab0;
 246 
					if (!(!is_floating(name(sh(op1))))) {
- 
 
 247 
						goto flab0;
- 
 
 248 
					}
218 
          if (last(xCCCC)) goto flab0;
 249 
					if (last(xCCCC)) {
- 
 
 250 
						goto flab0;
- 
 
 251 
					}
219 
          xCCCC = bro(xCCCC);
 252 
					xCCCC = bro(xCCCC);
220 
          op2 = xCCCC;
 253 
					op2 = xCCCC;
221 
          if(!last(xCCCC)) goto flab0;
 254 
					if (!last(xCCCC)) {
- 
 
 255 
						goto flab0;
222 
        }
 256 
					}
- 
 
 257 
				}
223 
        if(!last(xCCC)) goto flab0;
 258 
				if (!last(xCCC)) {
- 
 
 259 
					goto flab0;
224 
      }
 260 
				}
- 
 
 261 
			}
225 
      if (last(xCC)) goto flab0;
 262 
			if (last(xCC)) {
- 
 
 263 
				goto flab0;
- 
 
 264 
			}
226 
      xCC = bro(xCC);
 265 
			xCC = bro(xCC);
227 
      z = xCC;
 266 
			z = xCC;
228 
      if (!(complex_eq_exp(z, op1, nilexp,nilexp))) goto flab0;
 267 
			if (!(complex_eq_exp(z, op1, nilexp,nilexp))) {
- 
 
 268 
				goto flab0;
- 
 
 269 
			}
229 
      if(!last(xCC)) goto flab0;
 270 
			if (!last(xCC)) {
- 
 
 271 
				goto flab0;
230 
    }
 272 
			}
- 
 
 273 
		}
231 
    if (last(xC)) goto flab0;
 274 
		if (last(xC)) {
- 
 
 275 
			goto flab0;
- 
 
 276 
		}
232 
    xC = bro(xC);
 277 
		xC = bro(xC);
233 
    if (l != xC) goto flab0;
 278 
		if (l != xC) {
- 
 
 279 
			goto flab0;
- 
 
 280 
		}
- 
 
 281 
		{
234 
    { exp xCC = son(xC);
 282 
			exp xCC = son(xC);
235 
      z = xCC;
 283 
			z = xCC;
236 
      if (!(no(z)==1)) goto flab0;
 284 
			if (!(no(z) == 1)) {
- 
 
 285 
				goto flab0;
- 
 
 286 
			}
237 
      if (last(xCC)) goto flab0;
 287 
			if (last(xCC)) {
- 
 
 288 
				goto flab0;
- 
 
 289 
			}
238 
      xCC = bro(xCC);
 290 
			xCC = bro(xCC);
239 
      w = xCC;
 291 
			w = xCC;
240 
      if (!(complex_eq_exp(w, op2,nilexp,nilexp))) goto flab0;
 292 
			if (!(complex_eq_exp(w, op2, nilexp, nilexp))) {
- 
 
 293 
				goto flab0;
- 
 
 294 
			}
241 
      if(!last(xCC)) goto flab0;
 295 
			if (!last(xCC)) {
- 
 
 296 
				goto flab0;
242 
    }
 297 
			}
- 
 
 298 
		}
243 
    if(!last(xC)) goto flab0;
 299 
		if (!last(xC)) {
- 
 
 300 
			goto flab0;
244 
  }
 301 
		}
- 
 
 302 
	}
245 
  return 1;
 303 
	return 1;
- 
 
 304 
flab0:
246 
  flab0: return 0;
 305 
	return 0;
247 
}
 306 
}
- 
 
 307 
 
248 
 
 308 
 
249 
/* looks for things like
 309 
/* looks for things like
250 
	(a ~ b) ? b: a
 310 
	(a ~ b) ? b : a
251 
	puts test in t - can make use of delay-slot
 311 
	puts test in t - can make use of delay-slot
252 
*/
 312 
*/
253 
int is_minop
 313 
int
254 
    PROTO_N ( (x, t) )
 - 
 
255 
    PROTO_T ( exp x X exp *t )
 314 
is_minop(exp x, exp *t)
256 
{
 315 
{
257 
  exp op1, op2, z, l, w;
 316 
	exp op1, op2, z, l, w;
258 
  if (name(x) != cond_tag) goto flab0;
 317 
	if (name(x) != cond_tag) {
- 
 
 318 
		goto flab0;
- 
 
 319 
	}
- 
 
 320 
	{
259 
  { exp xC = son(x);
 321 
		exp xC = son(x);
260 
    if (name(xC) != seq_tag) goto flab0;
 322 
		if (name(xC) != seq_tag) {
- 
 
 323 
			goto flab0;
- 
 
 324 
		}
- 
 
 325 
		{
261 
    { exp xCC = son(xC);
 326 
			exp xCC = son(xC);
- 
 
 327 
			{
262 
      { exp xCCC = son(xCC);
 328 
				exp xCCC = son(xCC);
263 
        *t = xCCC;
 329 
				*t = xCCC;
264 
        if (name(xCCC) != test_tag) goto flab0;
 330 
				if (name(xCCC) != test_tag) {
- 
 
 331 
					goto flab0;
- 
 
 332 
				}
265 
        l=pt(*t);
 333 
				l=pt(*t);
- 
 
 334 
				{
266 
        { exp xCCCC = son(xCCC);
 335 
					exp xCCCC = son(xCCC);
267 
          op1 = xCCCC;
 336 
					op1 = xCCCC;
268 
          if (!(!is_floating(name(sh(op1))))) goto flab0;
 337 
					if (!(!is_floating(name(sh(op1))))) {
- 
 
 338 
						goto flab0;
- 
 
 339 
					}
269 
          if (last(xCCCC)) goto flab0;
 340 
					if (last(xCCCC)) {
- 
 
 341 
						goto flab0;
- 
 
 342 
					}
270 
          xCCCC = bro(xCCCC);
 343 
					xCCCC = bro(xCCCC);
271 
          op2 = xCCCC;
 344 
					op2 = xCCCC;
272 
          if(!last(xCCCC)) goto flab0;
 345 
					if (!last(xCCCC)) {
- 
 
 346 
						goto flab0;
273 
        }
 347 
					}
- 
 
 348 
				}
274 
        if(!last(xCCC)) goto flab0;
 349 
				if (!last(xCCC)) {
- 
 
 350 
					goto flab0;
275 
      }
 351 
				}
- 
 
 352 
			}
276 
      if (last(xCC)) goto flab0;
 353 
			if (last(xCC)) {
- 
 
 354 
				goto flab0;
- 
 
 355 
			}
277 
      xCC = bro(xCC);
 356 
			xCC = bro(xCC);
278 
      z = xCC;
 357 
			z = xCC;
279 
      if (!(complex_eq_exp(z, op2,nilexp,nilexp))) goto flab0;
 358 
			if (!(complex_eq_exp(z, op2,nilexp,nilexp))) {
- 
 
 359 
				goto flab0;
- 
 
 360 
			}
280 
      if(!last(xCC)) goto flab0;
 361 
			if (!last(xCC)) {
- 
 
 362 
				goto flab0;
281 
    }
 363 
			}
- 
 
 364 
		}
282 
    if (last(xC)) goto flab0;
 365 
		if (last(xC)) {
- 
 
 366 
			goto flab0;
- 
 
 367 
		}
283 
    xC = bro(xC);
 368 
		xC = bro(xC);
284 
    if (l != xC) goto flab0;
 369 
		if (l != xC) {
- 
 
 370 
			goto flab0;
- 
 
 371 
		}
- 
 
 372 
		{
285 
    { exp xCC = son(xC);
 373 
			exp xCC = son(xC);
286 
      z = xCC;
 374 
			z = xCC;
287 
      if (!(no(z)==1)) goto flab0;
 375 
			if (!(no(z) == 1)) {
- 
 
 376 
				goto flab0;
- 
 
 377 
			}
288 
      if (last(xCC)) goto flab0;
 378 
			if (last(xCC)) {
- 
 
 379 
				goto flab0;
- 
 
 380 
			}
289 
      xCC = bro(xCC);
 381 
			xCC = bro(xCC);
290 
      w = xCC;
 382 
			w = xCC;
291 
      if (!(complex_eq_exp(w, op1,nilexp,nilexp))) goto flab0;
 383 
			if (!(complex_eq_exp(w, op1,nilexp,nilexp))) {
- 
 
 384 
				goto flab0;
- 
 
 385 
			}
292 
      if(!last(xCC)) goto flab0;
 386 
			if (!last(xCC)) {
- 
 
 387 
				goto flab0;
293 
    }
 388 
			}
- 
 
 389 
		}
294 
    if(!last(xC)) goto flab0;
 390 
		if (!last(xC)) {
- 
 
 391 
			goto flab0;
295 
  }
 392 
		}
- 
 
 393 
	}
296 
  return 1;
 394 
	return 1;
- 
 
 395 
flab0:
297 
  flab0: return 0;
 396 
	return 0;
298 
}
 397 
}
299 
 
 398 
 
300 
#if condassign_implemented
 - 
 
301 
 
 399 
 
302 
int is_condassign
 400 
#if condassign_implemented
303 
    PROTO_N ( (e, to_test, to_ass) )
 - 
 
- 
 
 401 
 
- 
 
 402 
int
304 
    PROTO_T ( exp e X exp * to_test X exp * to_ass )
 403 
is_condassign(exp e, exp *to_test, exp *to_ass)
305 
{
 404 
{
306 
  exp arg1 = son(e);
 405 
	exp arg1 = son(e);
307 
  exp arg2 = bro(arg1);
 406 
	exp arg2 = bro(arg1);
308 
  exp z;
 407 
	exp z;
309 
  exp st;
 408 
	exp st;
310 
  exp ass;
 409 
	exp ass;
311 
  exp val;
 410 
	exp val;
312 
  if (name(arg1) != seq_tag)
 411 
	if (name(arg1) != seq_tag) {
313 
    return 0;
 412 
		return 0;
- 
 
 413 
	}
314 
 
 414 
 
315 
  z = son(arg1);
 415 
	z = son(arg1);
316 
  st = son(z);
 416 
	st = son(z);
317 
  ass = bro(z);
 417 
	ass = bro(z);
318 
 
 418 
 
319 
  if (no(son(arg2)) != 1 || name(bro(son(arg2))) != top_tag)
 419 
	if (no(son(arg2)) != 1 || name(bro(son(arg2))) != top_tag) {
320 
    return 0;
 420 
		return 0;
- 
 
 421 
	}
321 
  if (name(st) != test_tag && name(st) != testbit_tag)
 422 
	if (name(st) != test_tag && name(st) != testbit_tag) {
322 
    return 0;
 423 
		return 0;
- 
 
 424 
	}
323 
  if (!last(st))
 425 
	if (!last(st)) {
324 
    return 0;
 426 
		return 0;
- 
 
 427 
	}
325 
  if (name(ass) != ass_tag)
 428 
	if (name(ass) != ass_tag) {
326 
    return 0;
 429 
		return 0;
- 
 
 430 
	}
327 
  if (name(son(ass)) != name_tag || !isvar(son(son(ass))))
 431 
	if (name(son(ass)) != name_tag || !isvar(son(son(ass)))) {
328 
    return 0;
 432 
		return 0;
- 
 
 433 
	}
- 
 
 434 
 
- 
 
 435 
	val = bro(son(ass));
- 
 
 436 
	*to_test = st;
- 
 
 437 
	*to_ass = ass;
- 
 
 438 
	if (name(val) == val_tag) {
- 
 
 439 
		return 1;
- 
 
 440 
	}
329 
 
 441 
 
330 
  val = bro(son(ass));
 - 
 
331 
  *to_test = st;
 - 
 
332 
  *to_ass = ass;
 - 
 
333 
  if (name(val) == val_tag)
 - 
 
334 
    return 1;
 - 
 
335 
 
 - 
 
336 
  return 0;
 442 
	return 0;
337 
}
 443 
}
338 
#endif
 444 
#endif
339 
 
 - 
 
340 
 
 -