Subversion Repositories tendra.SVN

Rev

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

Rev 5 Rev 6
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
Line 10... Line 40...
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 
/**********************************************************************
 61 
/**********************************************************************
32 
$Author: release $
 62 
$Author: release $
33 
$Date: 1998/01/17 15:55:47 $
 63 
$Date: 1998/01/17 15:55:47 $
34 
$Revision: 1.1.1.1 $
 64 
$Revision: 1.1.1.1 $
Line 50... Line 80...
50 
 *
 80 
 *
51 
 * Revision 1.1  1995/04/06  10:44:05  currie
 81 
 * Revision 1.1  1995/04/06  10:44:05  currie
52 
 * Initial revision
 82 
 * Initial revision
53 
 *
 83 
 *
54 
***********************************************************************/
 84 
***********************************************************************/
55 
 
 85 
 
56 
 
 86 
 
57 
 
 87 
 
58 
#include "config.h"
 88 
#include "config.h"
59 
#include "common_types.h"
 89 
#include "common_types.h"
60 
#include "expmacs.h"
 90 
#include "expmacs.h"
61 
#include "tags.h"
 91 
#include "tags.h"
62 
#include "label_ops.h"
 92 
#include "label_ops.h"
Line 68... Line 98...
68 
 
 98 
 
69 
 
 99 
 
70 
/* label_is_next returns 1 if lab is a labst which immediately
 100 
/* label_is_next returns 1 if lab is a labst which immediately
71 
   follows e, otherwise 0. e will not be nilexp
 101 
   follows e, otherwise 0. e will not be nilexp
72 
*/
 102 
*/
73 
int label_is_next
 103 
int
74 
    PROTO_N ( (lab, e) )
 - 
 
75 
    PROTO_T ( exp lab X exp e )
 104 
label_is_next(exp lab, exp e)
76 
{
 105 
{
77 
  if (!indirect_jumps)
 106 
	if (!indirect_jumps) {
78 
    return 0;
 107 
		return 0;
- 
 
 108 
	}
79 
  while (last(e)) {
 109 
	while (last(e)) {
80 
    e = bro(e);
 110 
		e = bro(e);
81 
    if (e == nilexp || name(e) >= ass_tag || name(sh(e)) != bothd)
 111 
		if (e == nilexp || name(e) >= ass_tag || name(sh(e)) != bothd) {
82 
      return 0;
 112 
			return 0;
83 
  };
 113 
		}
- 
 
 114 
	}
84 
  if (name(bro(e)) == labst_tag)
 115 
	if (name(bro(e)) == labst_tag) {
85 
    return bro(e) == lab;
 116 
		return bro(e) == lab;
- 
 
 117 
	}
86 
  return 0;
 118 
	return 0;
87 
}
 119 
}
88 
 
 120 
 
- 
 
 121 
 
89 
static exp is_jumper
 122 
static exp
90 
    PROTO_N ( (e) )
 123 
is_jumper(exp e)
- 
 
 124 
{
- 
 
 125 
	if (name(e) == test_tag || name(e) == goto_tag ||
- 
 
 126 
	    name(e) == testbit_tag || name(e) == res_tag) {
- 
 
 127 
		return e;
- 
 
 128 
	}
- 
 
 129 
	return nilexp;
- 
 
 130 
}
- 
 
 131 
 
- 
 
 132 
 
- 
 
 133 
static exp
91 
    PROTO_T ( exp e )
 134 
down(exp e)
92 
{
 135 
{
93 
  if (name(e) == test_tag || name(e) == goto_tag ||
 136 
	if (name(e) == seq_tag) {
94 
	name(e) == testbit_tag || name(e) == res_tag)
 - 
 
95 
    return e;
 - 
 
96 
  return nilexp;
 137 
		return down(son(son(e)));
97 
}
 138 
	}
98 
 
 - 
 
99 
static exp down
 - 
 
100 
    PROTO_N ( (e) )
 - 
 
101 
    PROTO_T ( exp e )
 - 
 
102 
{
 - 
 
103 
  if (name(e) == seq_tag)
 - 
 
104 
    return down(son(son(e)));
 - 
 
105 
  if (name(e) == cond_tag)
 139 
	if (name(e) == cond_tag) {
106 
    return down(son(e));
 140 
		return down(son(e));
- 
 
 141 
	}
107 
  return e;
 142 
	return e;
108 
}
 143 
}
- 
 
 144 
 
109 
 
 145 
 
110 
/* next_jump delivers a goto, res, test or testbit exp if this
 146 
/* next_jump delivers a goto, res, test or testbit exp if this
111 
   is certain to be the next thing obeyed after e. nilexp
 147 
   is certain to be the next thing obeyed after e. nilexp
112 
   otherwise.
 148 
   otherwise.
113 
*/
 149 
*/
114 
static exp next_jump
 150 
static exp
115 
    PROTO_N ( (e) )
 - 
 
116 
    PROTO_T ( exp e )
 151 
next_jump(exp e)
117 
{
 152 
{
118 
  if (!indirect_jumps)
 153 
	if (!indirect_jumps) {
119 
    return nilexp;
 154 
		return nilexp;
- 
 
 155 
	}
120 
 
 156 
 
121 
  do {
 157 
	do {
122 
    while (last(e)) {
 158 
		while (last(e)) {
123 
      e = bro(e);
 159 
			e = bro(e);
124 
      if (e == nilexp || name(e) >= goto_tag)
 160 
			if (e == nilexp || name(e) >= goto_tag) {
125 
        return nilexp;
 161 
				return nilexp;
126 
    };
 162 
			}
- 
 
 163 
		}
127 
    e = bro(e);
 164 
		e = bro(e);
128 
  } while (name(e) == labst_tag && (e = father(e), name(e)!=rep_tag));
 165 
	} while (name(e) == labst_tag && (e = father(e), name(e) !=rep_tag));
129 
 
 166 
 
130 
  if (is_jumper(e))
 167 
	if (is_jumper(e)) {
131 
    return e;
 168 
		return e;
- 
 
 169 
	}
132 
  if (name(e) == seq_tag || name(e) == cond_tag)
 170 
	if (name(e) == seq_tag || name(e) == cond_tag) {
133 
    return is_jumper(down(e));
 171 
		return is_jumper(down(e));
- 
 
 172 
	}
134 
  if (name(e) == top_tag)
 173 
	if (name(e) == top_tag) {
135 
    return next_jump(e);
 174 
		return next_jump(e);
- 
 
 175 
	}
136 
  return nilexp;
 176 
	return nilexp;
137 
}
 177 
}
- 
 
 178 
 
138 
 
 179 
 
139 
/* next_jump delivers a goto, res, test or testbit exp if this
 180 
/* next_jump delivers a goto, res, test or testbit exp if this
140 
   is certain to be the next thing obeyed after e and there is no
 181 
   is certain to be the next thing obeyed after e and there is no
141 
   other route to the goto (etc.). nilexp otherwise.
 182 
   other route to the goto (etc.). nilexp otherwise.
142 
*/
 183 
*/
- 
 
 184 
exp
143 
exp short_next_jump
 185 
short_next_jump(exp e)
- 
 
 186 
{
- 
 
 187 
	if (!indirect_jumps) {
- 
 
 188 
		return nilexp;
- 
 
 189 
	}
- 
 
 190 
 
- 
 
 191 
	while (last(e)) {
- 
 
 192 
		e = bro(e);
- 
 
 193 
		if (e == nilexp || name(e) >= cond_tag) {
- 
 
 194 
			return nilexp;
- 
 
 195 
		}
- 
 
 196 
	}
- 
 
 197 
	e = bro(e);
- 
 
 198 
 
144 
    PROTO_N ( (e) )
 199 
	if (is_jumper(e)) {
- 
 
 200 
		return e;
- 
 
 201 
	}
- 
 
 202 
	if (name(e) == seq_tag || name(e) == cond_tag) {
- 
 
 203 
		return is_jumper(down(e));
- 
 
 204 
	}
- 
 
 205 
	if (name(e) == top_tag) {
- 
 
 206 
		return short_next_jump(e);
- 
 
 207 
	}
- 
 
 208 
	return nilexp;
- 
 
 209 
}
- 
 
 210 
 
- 
 
 211 
 
- 
 
 212 
exp
- 
 
 213 
jump_dest(exp lab)
- 
 
 214 
{
- 
 
 215 
	return next_jump(son(lab));
- 
 
 216 
}
- 
 
 217 
 
- 
 
 218 
 
- 
 
 219 
exp
145 
    PROTO_T ( exp e )
 220 
final_dest(exp lab)
146 
{
 221 
{
- 
 
 222 
	exp final = lab;
- 
 
 223 
	exp temp, ll;
- 
 
 224 
	while (name(final) == labst_tag) {
- 
 
 225 
		temp = jump_dest(final);
- 
 
 226 
		if (temp != nilexp && name(temp) == goto_tag &&
- 
 
 227 
		    pt(temp) != final) {
- 
 
 228 
			ll = lab;
- 
 
 229 
			while (ll != final) {
- 
 
 230 
				if (pt(temp) == ll) {
- 
 
 231 
					/* pathological loop */
- 
 
 232 
					return final;
- 
 
 233 
				}
- 
 
 234 
				ll = pt(jump_dest(ll));
- 
 
 235 
			}
147 
  if (!indirect_jumps)
 236 
			final = pt(temp);
- 
 
 237 
		} else {
- 
 
 238 
			break;
- 
 
 239 
		}
- 
 
 240 
	}
148 
    return nilexp;
 241 
	return final;
- 
 
 242 
}
149 
 
 243 
 
150 
    while (last(e)) {
 - 
 
151 
      e = bro(e);
 - 
 
152 
      if (e == nilexp || name(e) >= cond_tag)
 - 
 
153 
        return nilexp;
 - 
 
154 
    };
 - 
 
155 
    e = bro(e);
 - 
 
156 
 
 244 
 
- 
 
 245 
/* delivers 1 iff when a jumps, b also jumps
157 
  if (is_jumper(e))
 246 
   a and b will be test or testbit */
158 
    return e;
 247 
static int
159 
  if (name(e) == seq_tag || name(e) == cond_tag)
 248 
subsumes(exp a, exp b)
- 
 
 249 
{
160 
    return is_jumper(down(e));
 250 
	if (name(a) == name(b) && test_number(a) == test_number(b) &&
161 
  if (name(e) == top_tag)
 251 
	    eq_exp(son(a), son(b)) && eq_exp(bro(son(a)), bro(son(b)))) {
162 
    return short_next_jump(e);
 252 
		return 1;
- 
 
 253 
	}
163 
  return nilexp;
 254 
	return 0;
164 
}
 255 
}
165 
 
 256 
 
- 
 
 257 
 
166 
exp jump_dest
 258 
exp
167 
    PROTO_N ( (lab) )
 - 
 
168 
    PROTO_T ( exp lab )
 259 
final_dest_test(exp lab, exp e)
169 
{
 260 
{
- 
 
 261 
	exp final = lab;
- 
 
 262 
	exp temp, ll;
- 
 
 263 
	while (name(final) == labst_tag) {
- 
 
 264 
		temp = jump_dest(final);
- 
 
 265 
		if (temp == nilexp || final == pt(temp)) {
- 
 
 266 
			return final;
- 
 
 267 
		}
- 
 
 268 
		if (name(temp) == goto_tag ||
- 
 
 269 
		    (name(temp) == name(e) && subsumes(e, temp))) {
- 
 
 270 
			ll = lab;
- 
 
 271 
			while (ll != final) {
- 
 
 272 
				if (pt(temp) == ll) {
- 
 
 273 
					/* pathological loop */
- 
 
 274 
					return final;
- 
 
 275 
				}
170 
  return next_jump(son(lab));
 276 
				ll = pt(jump_dest(ll));
- 
 
 277 
			}
- 
 
 278 
			final = pt(temp);
- 
 
 279 
		} else {
- 
 
 280 
			break;
- 
 
 281 
		}
- 
 
 282 
	}
- 
 
 283 
	return final;
171 
}
 284 
}
172 
 
 - 
 
173 
exp final_dest
 - 
 
174 
    PROTO_N ( (lab) )
 - 
 
175 
    PROTO_T ( exp lab )
 - 
 
176 
{
 - 
 
177 
  exp final = lab;
 - 
 
178 
  exp temp, ll;
 - 
 
179 
  while (name(final) == labst_tag) {
 - 
 
180 
    temp = jump_dest(final);
 - 
 
181 
    if (temp != nilexp && name(temp) == goto_tag && pt(temp) != final) {
 - 
 
182 
      ll = lab;
 - 
 
183 
      while (ll != final) {
 - 
 
184 
	if (pt(temp) == ll)
 - 
 
185 
	  return final;		/* pathological loop */
 - 
 
186 
	ll = pt(jump_dest(ll));
 - 
 
187 
      }
 - 
 
188 
      final = pt(temp);
 - 
 
189 
    }
 - 
 
190 
    else
 - 
 
191 
      break;
 - 
 
192 
  };
 - 
 
193 
  return final;
 - 
 
194 
}
 - 
 
195 
 
 - 
 
196 
/* delivers 1 iff when a jumps, b also jumps
 - 
 
197 
   a and b will be test or testbit
 - 
 
198 
*/
 - 
 
199 
static int subsumes
 - 
 
200 
    PROTO_N ( (a, b) )
 - 
 
201 
    PROTO_T ( exp a X exp b )
 - 
 
202 
{
 - 
 
203 
  if (name(a) == name(b) &&
 - 
 
204 
	test_number(a) == test_number(b) &&
 - 
 
205 
	eq_exp(son(a), son(b)) &&
 - 
 
206 
	eq_exp(bro(son(a)), bro(son(b))))
 - 
 
207 
    return 1;
 - 
 
208 
  return 0;
 - 
 
209 
}
 - 
 
210 
 
 - 
 
211 
exp final_dest_test
 - 
 
212 
    PROTO_N ( (lab, e) )
 - 
 
213 
    PROTO_T ( exp lab X exp e )
 - 
 
214 
{
 - 
 
215 
  exp final = lab;
 - 
 
216 
  exp temp, ll;
 - 
 
217 
  while (name(final) == labst_tag) {
 - 
 
218 
    temp = jump_dest(final);
 - 
 
219 
    if (temp == nilexp || final == pt(temp))
 - 
 
220 
      return final;
 - 
 
221 
    if (name(temp) == goto_tag || (name(temp) == name(e) && subsumes(e, temp))) {
 - 
 
222 
      ll = lab;
 - 
 
223 
      while (ll != final) {
 - 
 
224 
	if (pt(temp) == ll)
 - 
 
225 
	  return final;		/* pathological loop */
 - 
 
226 
	ll = pt(jump_dest(ll));
 - 
 
227 
      }
 - 
 
228 
      final = pt(temp);
 - 
 
229 
    }
 - 
 
230 
    else
 - 
 
231 
      break;
 - 
 
232 
  };
 - 
 
233 
  return final;
 - 
 
234 
}
 - 
 
235 
 
 -