Subversion Repositories tendra.SVN

Rev

Rev 2 | Go to most recent revision | 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
Line 63... Line 93...
63 
#include "diagglob.h"
 93 
#include "diagglob.h"
64 
#include "dg_fns.h"
 94 
#include "dg_fns.h"
65 
#include "check.h"
 95 
#include "check.h"
66 
 
 96 
 
67 
#include "table_fns.h"
 97 
#include "table_fns.h"
68 
 
 - 
 
69 
 
 - 
 
70 
 
 98 
 
71 
 
 99 
 
72 
/* VARIABLES */
 100 
/* VARIABLES */
73 
/* The initial values are only to give something to push, jmf */
 101 
/* The initial values are only to give something to push, jmf */
74 
 
 - 
 
75 
 
 102 
 
76 
 
 - 
 
- 
 
 103 
context *crt_context = (context *)0;
77 
 
 104 
 
78 
context * crt_context = (context*)0;
 - 
 
79 
 
 105 
 
80 
/* IDENTITY */
 106 
/* IDENTITY */
81 
 
 107 
 
82 
static tokformals_list nil_params;
 108 
static tokformals_list nil_params;
83 
 
 109 
 
84 
 
 110 
 
85 
/* PROCEDURES */
 111 
/* PROCEDURES */
86 
 
 112 
 
87 
 
 113 
 
88 
exp get_lab
 114 
exp
89 
    PROTO_N ( (l) )
 - 
 
90 
    PROTO_T ( label l )
 115 
get_lab(label l)
91 
{
 116 
{
92 
	/* find the exp which is labelled by l */
 117 
	/* find the exp which is labelled by l */
93 
	context * con = crt_context;
 118 
	context *con = crt_context;
94 
	while (con != (context*)0) {
 119 
	while (con != (context *)0) {
95 
	   lab_con * lc = con->labs;
 120 
	   lab_con *lc = con->labs;
96 
	   while (lc != (lab_con*)0) {
 121 
	   while (lc != (lab_con *)0) {
97 
	   	if (lc->namel == l) return lc->e;
 122 
	   	if (lc->namel == l) {
- 
 
 123 
			return lc->e;
- 
 
 124 
		}
98 
		lc = lc->rest;
 125 
		lc = lc->rest;
99 
	   }
 126 
	   }
100 
	   con = con->outer;
 127 
	   con = con->outer;
101 
	}
 128 
	}
102 
	return *l;
 129 
	return *l;
103 
}
 130 
}
- 
 
 131 
 
104 
 
 132 
 
105 
void set_lab
 133 
void
106 
    PROTO_N ( (l, e) )
 - 
 
107 
    PROTO_T ( label l X exp e )
 134 
set_lab(label l, exp e)
108 
{
 135 
{
109 
  /* set the exp which is labelled by l */
 136 
	/* set the exp which is labelled by l */
110 
  if (crt_context == (context*)0 || crt_context->recursive == 0) {
 137 
	if (crt_context == (context *)0 || crt_context->recursive == 0) {
111 
  	*l = e;
 138 
		*l = e;
112 
  }
 - 
 
113 
  else {
 139 
	} else {
114 
  	lab_con * lc = (lab_con*)xmalloc(sizeof(lab_con));
 140 
		lab_con *lc = (lab_con *)xmalloc(sizeof(lab_con));
115 
	lc->namel = l; lc->e = e; lc->rest = crt_context->labs;
 141 
		lc->namel = l; lc->e = e; lc->rest = crt_context->labs;
116 
	crt_context->labs = lc;
 142 
		crt_context->labs = lc;
117 
  }
 143 
	}
118 
  return;
 144 
	return;
119 
}
 145 
}
120 
 
 146 
 
121 
 
 147 
 
122 
dec * get_dec
 148 
dec *
123 
    PROTO_N ( (tg) )
 - 
 
124 
    PROTO_T ( int tg )
 149 
get_dec(int tg)
125 
{
 150 
{
126 
  /* find the tag declaration indexed by tg */
 151 
	/* find the tag declaration indexed by tg */
127 
  dec * res = unit_ind_tags[tg];
 152 
	dec *res = unit_ind_tags[tg];
128 
  res->dec_u.dec_val.index = tg;
 153 
	res->dec_u.dec_val.index = tg;
129 
  return res;
 154 
	return res;
130 
}
 155 
}
- 
 
 156 
 
131 
 
 157 
 
132 
aldef * get_aldef
 158 
aldef *
133 
    PROTO_N ( (tg) )
 - 
 
134 
    PROTO_T ( int tg )
 159 
get_aldef(int tg)
135 
{
 160 
{
136 
  /* find the alignment tag value indexed by tg */
 161 
	/* find the alignment tag value indexed by tg */
137 
  return unit_ind_als[tg];
 162 
	return unit_ind_als[tg];
138 
}
 163 
}
- 
 
 164 
 
139 
 
 165 
 
140 
tok_define * get_tok
 166 
tok_define *
141 
    PROTO_N ( (tk) )
 - 
 
142 
    PROTO_T ( int tk )
 167 
get_tok(int tk)
143 
{
 168 
{
144 
  /* find the token declaration indexed by tg */
 169 
	/* find the token declaration indexed by tg */
145 
  context * con = crt_context;
 170 
	context *con = crt_context;
146 
  while (con != (context *)0) {
 171 
	while (con != (context *)0) {
147 
     int n = con->no_toks;
 172 
		int n = con->no_toks;
148 
     int nl = (n > LOCAL_TOKS)?LOCAL_TOKS:n;
 173 
		int nl = (n > LOCAL_TOKS) ? LOCAL_TOKS : n;
149 
     tok_define * cbind = &con->loctoks[0];
 174 
		tok_define *cbind = &con->loctoks[0];
150 
     int i;
 175 
		int i;
151 
     for(i=0; i<nl; i++) {
 176 
		for (i = 0; i < nl; i++) {
152 
     	if (tk == cbind[i].tdtoken) {
 177 
			if (tk == cbind[i].tdtoken) {
153 
		return & cbind[i];
 178 
				return &cbind[i];
- 
 
 179 
			}
- 
 
 180 
		}
- 
 
 181 
		cbind = con->othertoks;
- 
 
 182 
		for (i = LOCAL_TOKS; i < n; i++) {
- 
 
 183 
			if (tk == cbind[i - LOCAL_TOKS].tdtoken) {
- 
 
 184 
				return &cbind[i-LOCAL_TOKS];
- 
 
 185 
			}
- 
 
 186 
		}
- 
 
 187 
		con = con->outer;
154 
	}
 188 
	}
155 
     }
 - 
 
156 
     cbind = con->othertoks;
 - 
 
157 
     for(i=LOCAL_TOKS; i<n; i++) {
 - 
 
158 
     	if (tk == cbind[i-LOCAL_TOKS].tdtoken) {
 - 
 
159 
		return & cbind[i-LOCAL_TOKS];
 - 
 
160 
	}
 - 
 
161 
     }
 - 
 
162 
     con = con->outer;
 - 
 
163 
  }
 - 
 
164 
  return unit_ind_tokens[tk];
 189 
	return unit_ind_tokens[tk];
165 
}
 190 
}
166 
 
 191 
 
167 
 
 192 
 
168 
exp get_tag
 193 
exp
169 
    PROTO_N ( (tg) )
 - 
 
170 
    PROTO_T ( tag tg )
 194 
get_tag(tag tg)
171 
{
 195 
{
172 
	/* find the exp known as tg */
 196 
	/* find the exp known as tg */
173 
   	context * con = crt_context;
 197 
	context *con = crt_context;
174 
	while (con != (context*)0) {
 198 
	while (con != (context *)0) {
175 
	   tag_con * tc = con->tags;
 199 
		tag_con *tc = con->tags;
176 
	   while (tc != (tag_con*)0) {
 200 
		while (tc != (tag_con *)0) {
177 
	   	if (tc->namet == tg) return tc->e;
 201 
			if (tc->namet == tg) {
- 
 
 202 
				return tc->e;
- 
 
 203 
			}
178 
		tc = tc->rest;
 204 
			tc = tc->rest;
179 
	   }
 205 
		}
180 
	   con = con->outer;
 206 
		con = con->outer;
181 
	}
 207 
	}
182 
   	return tg -> dec_u.dec_val.dec_exp;
 208 
	return tg->dec_u.dec_val.dec_exp;
183 
}
 209 
}
184 
 
 - 
 
185 
 
 210 
 
186 
 
 211 
 
187 
void set_tag
 212 
void
188 
    PROTO_N ( (tg, e) )
 - 
 
189 
    PROTO_T ( tag tg X exp e )
 213 
set_tag(tag tg, exp e)
190 
{
 - 
 
191 
  /* set the exp known as tg */
 - 
 
192 
  if (crt_context == (context*)0 || crt_context->recursive == 0) {
 - 
 
193 
  	tg -> dec_u.dec_val.dec_exp = e;
 - 
 
194 
  }
 - 
 
195 
  else {
 - 
 
196 
  	tag_con * tc = (tag_con*)xmalloc(sizeof(tag_con));
 - 
 
197 
	tc->namet = tg; tc->e = e; tc->rest = crt_context->tags;
 - 
 
198 
	crt_context->tags = tc;
 - 
 
199 
  }
 - 
 
200 
  return;
 - 
 
201 
}
 - 
 
202 
 
 - 
 
203 
 
 - 
 
204 
  /* apply tk to its parameters in pars, and return the result */
 - 
 
205 
tokval apply_tok
 - 
 
206 
    PROTO_N ( (td, pars, sortcode, actual_pars) )
 - 
 
207 
    PROTO_T ( token td X bitstream pars X int sortcode X tokval * actual_pars )
 - 
 
208 
{
 214 
{
209 
  if (td -> tok_special || td -> defined == 0)
 - 
 
210 
	  /* handle the special tokens */
 215 
	/* set the exp known as tg */
211 
    { tokval tkv;
 - 
 
212 
      int done = 0;
 - 
 
213 
      tkv = special_token(td, pars, sortcode, &done);
 - 
 
214 
      if (done)
 - 
 
215 
        return tkv;
 - 
 
216 
    };
 - 
 
217 
 
 - 
 
218 
  if (td -> defined == 0)
 - 
 
219 
   {
 - 
 
220 
     /* detect various errors and give helpful information */
 216 
	if (crt_context == (context *)0 || crt_context->recursive == 0) {
221 
     if (td -> defined == 0)
 217 
		tg->dec_u.dec_val.dec_exp = e;
222 
       failer(UNDEFINED_TOK);
 - 
 
223 
 
 - 
 
224 
     if (td -> is_capsule_token &&
 - 
 
225 
         td -> tok_index < capsule_no_of_tokens &&
 - 
 
226 
         td -> tok_index >= 0 &&
 - 
 
227 
         td -> tok_name != (char*)0)
 - 
 
228 
        IGNORE fprintf(stderr, "token is: %s\n", td -> tok_name);
 - 
 
229 
     else
 218 
	} else {
230 
      {
 - 
 
231 
        if (td -> is_capsule_token &&
 - 
 
232 
            td -> tok_index < capsule_no_of_tokens &&
 219 
		tag_con *tc = (tag_con *)xmalloc(sizeof(tag_con));
233 
            td -> tok_index >= 0)
 - 
 
234 
           IGNORE fprintf(stderr, "capsule token number: %d\n", td -> tok_index);
 - 
 
235 
        else
 - 
 
236 
         {
 - 
 
237 
           if (td -> tok_index >= 0 &&
 - 
 
238 
               td -> tok_index < unit_no_of_tokens)
 - 
 
239 
              IGNORE fprintf(stderr, "local unit token number: %d\n",
 - 
 
240 
                       td -> tok_index);
 - 
 
241 
           else
 - 
 
242 
              IGNORE fprintf(stderr, "token number out of bounds\n");
 - 
 
243 
         };
 - 
 
244 
      };
 - 
 
245 
     exit(EXIT_FAILURE);
 - 
 
246 
   };
 - 
 
247 
 
 - 
 
248 
 {
 - 
 
249 
  int npars = td -> params.number;  /* number of parameters */
 - 
 
250 
  context new_context; /* to construct the bindings for this expansion */
 - 
 
251 
  context * old_context = crt_context;
 220 
		tc->namet = tg; tc->e = e; tc->rest = crt_context->tags;
252 
 
 - 
 
253 
  tokval val;
 - 
 
254 
  place old_place;  /* to record the current place in the input stream */
 - 
 
255 
  tok_define * new_bindings;
 - 
 
256 
  int i,j;
 - 
 
257 
  dec * * old_tagtab;
 - 
 
258 
     /* to remember the current tag table */
 - 
 
259 
  exp* old_labtab;
 - 
 
260 
     /* to remember the current label table */
 - 
 
261 
  tok_define * * old_toktab;
 - 
 
262 
     /* to remember the current token table */
 - 
 
263 
  aldef * * old_altab;
 - 
 
264 
     /* to remember the current alignment tag table */
 - 
 
265 
  diag_tagdef * * old_diagtab;		/* OLD DIAGS */
 - 
 
266 
  dgtag_struct * * old_dgtab;		/* NEW DIAGS */
 - 
 
267 
 
 - 
 
268 
     /* now remember them */
 - 
 
269 
  old_tagtab = unit_ind_tags;
 - 
 
270 
  old_labtab = unit_labtab;
 - 
 
271 
  old_toktab = unit_ind_tokens;
 - 
 
272 
  old_altab = unit_ind_als;
 - 
 
273 
  old_diagtab = unit_ind_diagtags;	/* OLD DIAGS */
 - 
 
274 
  old_dgtab = unit_ind_dgtags;		/* NEW DIAGS */
 - 
 
275 
 
 - 
 
276 
  new_context.no_toks = (short) npars;
 221 
		crt_context->tags = tc;
277 
  nil_params.number = 0;
 - 
 
278 
 
 - 
 
279 
  if (td -> valpresent &&
 - 
 
280 
       (td -> unit_number == crt_tagdef_unit_no ))
 - 
 
281 
    {
 - 
 
282 
      /* if a value has already been computed
 - 
 
283 
         (there will be no parameters) */
 - 
 
284 
 
 - 
 
285 
          if (sortcode == f_exp.code)
 - 
 
286 
           {tokval v;
 - 
 
287 
            v.tk_exp = copy(td -> tdvalue.tk_exp);
 - 
 
288 
              /* copy it if the result is an expression since
 - 
 
289 
                 we may be going to alter it */
 - 
 
290 
            return v;
 - 
 
291 
           }
 - 
 
292 
          else  {
 - 
 
293 
            return td -> tdvalue;
 - 
 
294 
	  };
 222 
	}
295 
    };
 223 
	return;
296 
 
 - 
 
297 
  old_place = keep_place();  /* remember the current input stream */
 - 
 
298 
  set_place(pars);
 - 
 
299 
 
 224 
}
300 
     /* now set up the new parameter bindings */
 - 
 
301 
  if (npars > LOCAL_TOKS) {
 - 
 
302 
    new_context.othertoks = (tok_define *) xcalloc (npars-LOCAL_TOKS,
 - 
 
303 
                            			sizeof (tok_define));
 - 
 
304 
  }
 - 
 
305 
 
 225 
 
306 
  new_bindings = &new_context.loctoks[0];
 - 
 
307 
 
 226 
 
- 
 
 227 
/* apply tk to its parameters in pars, and return the result */
- 
 
 228 
tokval
- 
 
 229 
apply_tok(token td, bitstream pars, int sortcode, tokval * actual_pars)
- 
 
 230 
{
- 
 
 231 
	if (td->tok_special || td -> defined == 0) {
- 
 
 232 
		/* handle the special tokens */
- 
 
 233 
		tokval tkv;
- 
 
 234 
		int done = 0;
- 
 
 235 
		tkv = special_token(td, pars, sortcode, &done);
- 
 
 236 
		if (done) {
- 
 
 237 
			return tkv;
- 
 
 238 
		}
- 
 
 239 
	}
- 
 
 240 
 
- 
 
 241 
	if (td->defined == 0) {
- 
 
 242 
		/* detect various errors and give helpful information */
- 
 
 243 
		if (td->defined == 0) {
- 
 
 244 
			failer(UNDEFINED_TOK);
- 
 
 245 
		}
- 
 
 246 
 
- 
 
 247 
		if (td->is_capsule_token &&
- 
 
 248 
		    td->tok_index < capsule_no_of_tokens &&
- 
 
 249 
		    td->tok_index >= 0 &&
- 
 
 250 
		    td->tok_name != (char *)0) {
- 
 
 251 
			IGNORE fprintf(stderr, "token is: %s\n",
- 
 
 252 
				       td -> tok_name);
- 
 
 253 
		} else {
- 
 
 254 
			if (td->is_capsule_token &&
- 
 
 255 
			    td->tok_index < capsule_no_of_tokens &&
- 
 
 256 
			    td->tok_index >= 0) {
- 
 
 257 
				IGNORE fprintf(stderr,
- 
 
 258 
					       "capsule token number: %d\n",
- 
 
 259 
					       td -> tok_index);
- 
 
 260 
			} else {
- 
 
 261 
				if (td->tok_index >= 0 &&
- 
 
 262 
				    td->tok_index < unit_no_of_tokens) {
- 
 
 263 
					IGNORE fprintf(stderr,
- 
 
 264 
					    "local unit token number: %d\n",
- 
 
 265 
					    td->tok_index);
- 
 
 266 
				} else {
- 
 
 267 
					IGNORE fprintf(stderr,
- 
 
 268 
					    "token number out of bounds\n");
- 
 
 269 
				}
- 
 
 270 
			}
- 
 
 271 
			exit(EXIT_FAILURE);
- 
 
 272 
		}
- 
 
 273 
	}
- 
 
 274 
 
- 
 
 275 
	{
- 
 
 276 
		/* number of parameters */
- 
 
 277 
		int npars = td->params.number;
- 
 
 278 
		/* to construct the bindings for this expansion */
- 
 
 279 
		context new_context;
- 
 
 280 
		context *old_context = crt_context;
- 
 
 281 
 
- 
 
 282 
		tokval val;
- 
 
 283 
		/* to record the current place in the input stream */
- 
 
 284 
		place old_place;
- 
 
 285 
 
- 
 
 286 
		tok_define *new_bindings;
- 
 
 287 
		int i, j;
- 
 
 288 
		dec **old_tagtab;
- 
 
 289 
		/* to remember the current tag table */
- 
 
 290 
		exp *old_labtab;
- 
 
 291 
		/* to remember the current label table */
- 
 
 292 
		tok_define **old_toktab;
- 
 
 293 
		/* to remember the current token table */
- 
 
 294 
		aldef **old_altab;
- 
 
 295 
		/* to remember the current alignment tag table */
- 
 
 296 
		diag_tagdef **old_diagtab;		/* OLD DIAGS */
- 
 
 297 
		dgtag_struct **old_dgtab;		/* NEW DIAGS */
- 
 
 298 
 
- 
 
 299 
		/* now remember them */
- 
 
 300 
		old_tagtab = unit_ind_tags;
- 
 
 301 
		old_labtab = unit_labtab;
- 
 
 302 
		old_toktab = unit_ind_tokens;
- 
 
 303 
		old_altab = unit_ind_als;
- 
 
 304 
		old_diagtab = unit_ind_diagtags;	/* OLD DIAGS */
- 
 
 305 
		old_dgtab = unit_ind_dgtags;		/* NEW DIAGS */
- 
 
 306 
 
- 
 
 307 
		new_context.no_toks = (short)npars;
- 
 
 308 
		nil_params.number = 0;
- 
 
 309 
 
- 
 
 310 
		if (td -> valpresent &&
- 
 
 311 
				(td -> unit_number == crt_tagdef_unit_no)) {
- 
 
 312 
			/* if a value has already been computed (there
- 
 
 313 
			 * will be no parameters) */
- 
 
 314 
 
- 
 
 315 
			if (sortcode == f_exp.code) {
- 
 
 316 
				tokval v;
- 
 
 317 
				v.tk_exp = copy(td->tdvalue.tk_exp);
- 
 
 318 
				/* copy it if the result is an
- 
 
 319 
				 * expression since we may be going to
- 
 
 320 
				 * alter it */
- 
 
 321 
				return v;
- 
 
 322 
			} else  {
- 
 
 323 
				return td -> tdvalue;
- 
 
 324 
			}
- 
 
 325 
		}
- 
 
 326 
 
- 
 
 327 
		/* remember the current input stream */
- 
 
 328 
		old_place = keep_place();
- 
 
 329 
 
- 
 
 330 
		set_place(pars);
- 
 
 331 
 
- 
 
 332 
		/* now set up the new parameter bindings */
- 
 
 333 
		if (npars > LOCAL_TOKS) {
- 
 
 334 
			new_context.othertoks =
- 
 
 335 
				(tok_define *)xcalloc(npars - LOCAL_TOKS,
- 
 
 336 
						      sizeof(tok_define));
- 
 
 337 
		}
- 
 
 338 
 
- 
 
 339 
		new_bindings = &new_context.loctoks[0];
- 
 
 340 
 
- 
 
 341 
		for (j = 0; j < npars; ++j) {
- 
 
 342 
			/* read in the parameter values and bind them
- 
 
 343 
			 * to the formals */
- 
 
 344 
			sortname sn;
- 
 
 345 
			exp old_crt_repeat;  /* XX008 */
- 
 
 346 
			if (j >= LOCAL_TOKS) {
- 
 
 347 
				i = j - LOCAL_TOKS;
- 
 
 348 
				new_bindings = new_context.othertoks;
- 
 
 349 
			} else {
- 
 
 350 
				i = j;
- 
 
 351 
			}
- 
 
 352 
			sn = (td->params.par_sorts)[j];
- 
 
 353 
			new_bindings[i].tdsort = sn;
- 
 
 354 
			/* parameter sort */
- 
 
 355 
			new_bindings[i].tdtoken =
- 
 
 356 
				(td->params.par_names)[j];
- 
 
 357 
			/* formal */
- 
 
 358 
			new_bindings[i].valpresent = 1;
- 
 
 359 
			/* the value is known */
- 
 
 360 
			new_bindings[i].unit_number =
- 
 
 361 
				crt_tagdef_unit_no;
- 
 
 362 
			new_bindings[i].re_evaluate = 0;
- 
 
 363 
			/* and does not need re-evaluating */
- 
 
 364 
			new_bindings[i].params = nil_params;
- 
 
 365 
			/* it has no parameters itself */
- 
 
 366 
 
- 
 
 367 
			/* XX008 */
- 
 
 368 
			if (sn.code == f_exp.code) {
- 
 
 369 
				old_crt_repeat = crt_repeat;
- 
 
 370 
				crt_repeat = nilexp;
- 
 
 371 
			} else {
- 
 
 372 
				SET(old_crt_repeat);
- 
 
 373 
			}
- 
 
 374 
			if (actual_pars != (tokval*)0) {
- 
 
 375 
				/* this is not used at present*/
- 
 
 376 
				new_bindings[i].tdvalue =
- 
 
 377 
					actual_pars[j];
- 
 
 378 
			} else {
- 
 
 379 
				new_bindings[i].tdvalue =
- 
 
 380 
					read_sort(sn.code);
- 
 
 381 
			}
- 
 
 382 
			/* read a parameter */
- 
 
 383 
			/* XX008 */
- 
 
 384 
			if (sn.code == f_exp.code) {
- 
 
 385 
				crt_repeat = old_crt_repeat;
- 
 
 386 
			}
- 
 
 387 
 
- 
 
 388 
			new_bindings[i].defined = 1;
- 
 
 389 
			/* and say it is defined */
- 
 
 390 
			new_bindings[i].tok_special = 0;
- 
 
 391 
			/* and say it is not special */
- 
 
 392 
			new_bindings[i].recursive = (sn.code == TOKEN);
- 
 
 393 
			/* and say it is not recursive for simple
- 
 
 394 
			 * sorts */
- 
 
 395 
			new_bindings[i].tok_context = crt_context;
- 
 
 396 
		}
- 
 
 397 
 
- 
 
 398 
		/* set up the place to read the definition */
- 
 
 399 
		set_place(td->tdplace);
- 
 
 400 
 
- 
 
 401 
		new_context.recursive = td->recursive;
- 
 
 402 
		new_context.outer = td->tok_context;
- 
 
 403 
		new_context.tags = (tag_con *)0;
- 
 
 404 
		new_context.labs = (lab_con *)0;
- 
 
 405 
 
- 
 
 406 
		crt_context = &new_context;
- 
 
 407 
 
- 
 
 408 
		/* now set up the tables which belong to the place
- 
 
 409 
		 * where the token was defined */
- 
 
 410 
		unit_ind_tags = td->my_tagtab;
- 
 
 411 
		unit_labtab = td->my_labtab;
- 
 
 412 
		unit_ind_tokens = td->my_toktab;
- 
 
 413 
		unit_ind_als = td->my_altab;
- 
 
 414 
		unit_ind_diagtags = td->my_diagtab;	/* OLD DIAGS */
- 
 
 415 
		unit_ind_dgtags = td->my_dgtab;		/* NEW DIAGS */
- 
 
 416 
 
- 
 
 417 
		/* read the body of the definition */
- 
 
 418 
		td->recursive = 1;  /* set up to detect recursion */
- 
 
 419 
		val = read_sort(sortcode);
- 
 
 420 
		td->recursive = new_context.recursive;
- 
 
 421 
 
- 
 
 422 
		/* restore the place in the input stream */
- 
 
 423 
		set_place(old_place);
308 
 
 424 
 
309 
  for (j=0; j<npars; ++j)
 - 
 
310 
   {
 - 
 
311 
        /* read in the parameter values and bind them to the formals */
 - 
 
312 
      sortname sn;
 - 
 
313 
      exp old_crt_repeat;  /* XX008 */
 - 
 
314 
      if (j>=LOCAL_TOKS) {
 - 
 
315 
      	i = j-LOCAL_TOKS; new_bindings = new_context.othertoks;
 - 
 
316 
      }
 - 
 
317 
      else i = j;
 - 
 
318 
      sn = (td -> params.par_sorts)[j];
 - 
 
319 
      new_bindings[i].tdsort = sn;
 - 
 
320 
          /* parameter sort */
 - 
 
321 
      new_bindings[i].tdtoken = (td -> params.par_names)[j];
 - 
 
322 
          /* formal */
 - 
 
323 
      new_bindings[i].valpresent = 1;
 - 
 
324 
          /* the value is known */
 - 
 
325 
      new_bindings[i].unit_number = crt_tagdef_unit_no;
 - 
 
326 
      new_bindings[i].re_evaluate = 0;
 - 
 
327 
          /* and does not need re-evaluating */
 - 
 
328 
      new_bindings[i].params = nil_params;
 - 
 
329 
          /* it has no parameters itself */
 - 
 
330 
 
 - 
 
331 
      if (sn.code == f_exp.code) {  /* XX008 */
 - 
 
332 
	old_crt_repeat = crt_repeat;
 - 
 
333 
	crt_repeat = nilexp;
 - 
 
334 
      }
 - 
 
335 
      else {
 - 
 
336 
	SET(old_crt_repeat);
 - 
 
337 
      };
 - 
 
338 
      if (actual_pars != (tokval*)0) {
 - 
 
339 
	new_bindings[i].tdvalue = actual_pars[j]; /* this is not used at present*/
 - 
 
340 
      }
 - 
 
341 
      else {
 - 
 
342 
        new_bindings[i].tdvalue = read_sort(sn.code);
 - 
 
343 
      }
 - 
 
344 
          /* read a parameter */
 - 
 
345 
      if (sn.code == f_exp.code) {  /* XX008 */
 - 
 
346 
	crt_repeat = old_crt_repeat;
 - 
 
347 
      };
 - 
 
348 
 
 - 
 
349 
      new_bindings[i].defined = 1;
 - 
 
350 
          /* and say it is defined */
 - 
 
351 
      new_bindings[i].tok_special = 0;
 - 
 
352 
          /* and say it is not special */
 - 
 
353 
      new_bindings[i].recursive = (sn.code == TOKEN);
 - 
 
354 
          /* and say it is not recursive for simple sorts */
 - 
 
355 
      new_bindings[i].tok_context = crt_context;
 - 
 
356 
   };
 - 
 
357 
 
 - 
 
358 
  set_place(td -> tdplace);  /* set up the place to read the definition */
 - 
 
359 
 
 - 
 
360 
  new_context.recursive = td -> recursive;
 - 
 
361 
  new_context.outer = td -> tok_context;
 - 
 
362 
  new_context.tags = (tag_con *)0;
 - 
 
363 
  new_context.labs = (lab_con *)0;
 - 
 
364 
 
 - 
 
365 
  crt_context = &new_context;
 - 
 
366 
 
 - 
 
367 
   /* now set up the tables which belong to the place where the
 - 
 
368 
      token was defined */
 - 
 
369 
  unit_ind_tags = td -> my_tagtab;
 - 
 
370 
  unit_labtab = td -> my_labtab;
 - 
 
371 
  unit_ind_tokens = td -> my_toktab;
 - 
 
372 
  unit_ind_als = td -> my_altab;
 - 
 
373 
  unit_ind_diagtags = td -> my_diagtab;		/* OLD DIAGS */
 - 
 
374 
  unit_ind_dgtags = td -> my_dgtab;		/* NEW DIAGS */
 - 
 
375 
 
 - 
 
376 
  /* read the body of the definition */
 - 
 
377 
  td -> recursive = 1;  /* set up to detect recursion */
 - 
 
378 
  val = read_sort(sortcode);
 - 
 
379 
  td -> recursive = new_context.recursive;
 - 
 
380 
 
 - 
 
381 
  set_place(old_place);  /* restore the place in the input stream */
 - 
 
382 
 
 - 
 
383 
  new_bindings = &new_context.loctoks[0];
 425 
		new_bindings = &new_context.loctoks[0];
384 
 
 - 
 
385 
  for (j = 0; j < npars; ++j) {/* kill off exps (they were copied) */
 - 
 
386 
    tok_define * q;
 - 
 
387 
    if (j>=LOCAL_TOKS) {
 - 
 
388 
    	i = j-LOCAL_TOKS; new_bindings = new_context.othertoks;
 - 
 
389 
    }
 - 
 
390 
    else i = j;
 - 
 
391 
    q = &new_bindings[i];
 - 
 
392 
    if (q -> tdsort.code == f_exp.code) {
 - 
 
393 
      exp ek = q -> tdvalue.tk_exp;
 - 
 
394 
      kill_exp (ek, ek);
 - 
 
395 
    };
 - 
 
396 
  };
 - 
 
397 
 
 - 
 
398 
    /* restore the old environment of tables */
 - 
 
399 
  crt_context = old_context;
 - 
 
400 
  unit_ind_tags = old_tagtab;
 - 
 
401 
  unit_labtab = old_labtab;
 - 
 
402 
  unit_ind_tokens = old_toktab;
 - 
 
403 
  unit_ind_als = old_altab;
 - 
 
404 
  unit_ind_diagtags = old_diagtab;	/* OLD DIAGS */
 - 
 
405 
  unit_ind_dgtags = old_dgtab;		/* NEW DIAGS */
 - 
 
406 
 
 - 
 
407 
  if (!doing_aldefs && npars == 0 && new_context.recursive == 0)
 - 
 
408 
   {
 - 
 
409 
          /* if there were no parameters, record the value for the
 - 
 
410 
             next application of the token */
 - 
 
411 
	td -> valpresent = 1;
 - 
 
412 
	td -> tdvalue = val;
 - 
 
413 
	if (sortcode == f_exp.code)
 - 
 
414 
           {tokval v;
 - 
 
415 
            v.tk_exp = copy(val.tk_exp);
 - 
 
416 
              /* if we are remembering it we must copy, because the
 - 
 
417 
                 returned value might be altered */
 - 
 
418 
	    IGNORE hold(val.tk_exp);
 - 
 
419 
            return v;
 - 
 
420 
           };
 - 
 
421 
   }
 - 
 
422 
  else
 - 
 
423 
  if (npars > LOCAL_TOKS)
 - 
 
424 
       xfree((void *)new_context.othertoks);
 - 
 
425 
          /* free the space used for parameter binding */
 - 
 
426 
  while(new_context.tags != (tag_con*)0) {
 - 
 
427 
  	tag_con * r = new_context.tags;
 - 
 
428 
	new_context.tags = new_context.tags->rest;
 - 
 
429 
	xfree((void *)r);
 - 
 
430 
  }
 - 
 
431 
  while(new_context.labs != (lab_con*)0) {
 - 
 
432 
  	lab_con * r = new_context.labs;
 - 
 
433 
	new_context.labs = new_context.labs->rest;
 - 
 
434 
	xfree((void *)r);
 - 
 
435 
  }
 - 
 
436 
  return val;
 - 
 
437 
 };
 - 
 
438 
}
 - 
 
439 
 
 426 
 
- 
 
 427 
		/* kill off exps (they were copied) */
- 
 
 428 
		for (j = 0; j < npars; ++j) {
- 
 
 429 
			tok_define *q;
- 
 
 430 
			if (j >= LOCAL_TOKS) {
- 
 
 431 
				i = j - LOCAL_TOKS;
- 
 
 432 
				new_bindings = new_context.othertoks;
- 
 
 433 
			} else {
- 
 
 434 
				i = j;
- 
 
 435 
			}
- 
 
 436 
			q = &new_bindings[i];
- 
 
 437 
			if (q->tdsort.code == f_exp.code) {
- 
 
 438 
				exp ek = q->tdvalue.tk_exp;
- 
 
 439 
				kill_exp(ek, ek);
- 
 
 440 
			}
- 
 
 441 
		}
440 
 
 442 
 
- 
 
 443 
		/* restore the old environment of tables */
- 
 
 444 
		crt_context = old_context;
- 
 
 445 
		unit_ind_tags = old_tagtab;
- 
 
 446 
		unit_labtab = old_labtab;
- 
 
 447 
		unit_ind_tokens = old_toktab;
- 
 
 448 
		unit_ind_als = old_altab;
- 
 
 449 
		unit_ind_diagtags = old_diagtab;	/* OLD DIAGS */
- 
 
 450 
		unit_ind_dgtags = old_dgtab;		/* NEW DIAGS */
441 
 
 451 
 
- 
 
 452 
		if (!doing_aldefs && npars == 0 &&
- 
 
 453 
				new_context.recursive == 0) {
- 
 
 454 
			/* if there were no parameters, record the
- 
 
 455 
			 * value for the next application of the
- 
 
 456 
			 * token */
- 
 
 457 
			td->valpresent = 1;
- 
 
 458 
			td->tdvalue = val;
- 
 
 459 
			if (sortcode == f_exp.code) {
- 
 
 460 
				tokval v;
- 
 
 461 
				v.tk_exp = copy(val.tk_exp);
- 
 
 462 
				/* if we are remembering it we must
- 
 
 463 
				 * copy, because the returned value
- 
 
 464 
				 * might be altered */
- 
 
 465 
				IGNORE hold(val.tk_exp);
- 
 
 466 
				return v;
- 
 
 467 
			}
- 
 
 468 
		} else {
- 
 
 469 
			if (npars > LOCAL_TOKS) {
- 
 
 470 
				xfree((void *)new_context.othertoks);
- 
 
 471 
				/* free the space used for parameter
- 
 
 472 
				 * binding */
- 
 
 473 
			}
- 
 
 474 
		}
- 
 
 475 
		while (new_context.tags != (tag_con *)0) {
- 
 
 476 
			tag_con *r = new_context.tags;
- 
 
 477 
			new_context.tags =
- 
 
 478 
				new_context.tags->rest;
- 
 
 479 
			xfree((void *)r);
- 
 
 480 
		}
- 
 
 481 
		while (new_context.labs != (lab_con *)0) {
- 
 
 482 
			lab_con *r = new_context.labs;
- 
 
 483 
			new_context.labs =
- 
 
 484 
				new_context.labs->rest;
- 
 
 485 
			xfree((void *)r);
- 
 
 486 
		}
- 
 
 487 
		return val;
- 
 
 488 
	}
- 
 
 489 
}