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 
    		 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
9 
    to other parties and amendment for any purpose not excluding
 39 
    to other parties and amendment for any purpose not excluding
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 
#include "config.h"
 61 
#include "config.h"
32 
#include "types.h"
 62 
#include "types.h"
33 
#include "de_types.h"
 63 
#include "de_types.h"
- 
 
 64 
#include "de_capsule.h"
34 
#include "de_unit.h"
 65 
#include "de_unit.h"
35 
#include "decode.h"
 66 
#include "decode.h"
36 
#include "fetch.h"
 67 
#include "fetch.h"
37 
#include "names.h"
 68 
#include "names.h"
38 
#include "node.h"
 69 
#include "node.h"
Line 47... Line 78...
47 
    A value of 0 indicates that we are decoding the names at the start
 78 
    A value of 0 indicates that we are decoding the names at the start
48 
    of the capsule, 1 that we are decoding the linkage information, and
 79 
    of the capsule, 1 that we are decoding the linkage information, and
49 
    2 that we are decoding a main equation body.
 80 
    2 that we are decoding a main equation body.
50 
*/
 81 
*/
51 
 
 82 
 
52 
int decode_status = -1 ;
 83 
int decode_status = -1;
53 
 
 84 
 
54 
 
 85 
 
55 
/*
 86 
/*
56 
    FLAG : ONLY DECODE TOKEN DECLARATIONS
 87 
    FLAG : ONLY DECODE TOKEN DECLARATIONS
57 
 
 88 
 
58 
    This flag is true if we are only interested in the token
 89 
    This flag is true if we are only interested in the token
59 
    declarations in a capsule.
 90 
    declarations in a capsule.
60 
*/
 91 
*/
61 
 
 92 
 
62 
boolean extract_tokdecs = 0 ;
 93 
boolean extract_tokdecs = 0;
63 
 
 94 
 
64 
 
 95 
 
65 
/*
 96 
/*
66 
    THE ARRAY OF ALL VARIABLE SORTS
 97 
    THE ARRAY OF ALL VARIABLE SORTS
67 
 
 98 
 
68 
    The array vars of size no_var gives all variable sorts.  The
 99 
    The array vars of size no_var gives all variable sorts.  The
69 
    indexes in this array of the alignment tags, tags and tokens are
 100 
    indexes in this array of the alignment tags, tags and tokens are
70 
    given by al_tag_var, tag_var, tok_var respectively.
 101 
    given by al_tag_var, tag_var, tok_var respectively.
71 
*/
 102 
*/
72 
 
 103 
 
73 
static long no_var ;
 104 
static long no_var;
74 
static var_sort *vars ;
 105 
static var_sort *vars;
75 
long al_tag_var, tag_var, tok_var ;
 106 
long al_tag_var, tag_var, tok_var;
76 
 
 107 
 
77 
 
 108 
 
78 
/*
 109 
/*
79 
    LIST OF UNUSED CONSTRUCTS
 110 
    LIST OF UNUSED CONSTRUCTS
80 
 
 111 
 
81 
    All unused constructs in a capsule are formed into a list for
 112 
    All unused constructs in a capsule are formed into a list for
82 
    later reuse.
 113 
    later reuse.
83 
*/
 114 
*/
84 
 
 115 
 
85 
static construct *garbage = null ;
 116 
static construct *garbage = null;
86 
 
 117 
 
87 
 
 118 
 
88 
/*
 119 
/*
89 
    CURRENT BINDINGS
 120 
    CURRENT BINDINGS
90 
 
 121 
 
91 
    The current bindings are held in crt_binding.  spare_binding, if not
 122 
    The current bindings are held in crt_binding.  spare_binding, if not
92 
    null, contains a binding suitable for reuse.
 123 
    null, contains a binding suitable for reuse.
93 
*/
 124 
*/
94 
 
 125 
 
95 
binding *crt_binding ;
 126 
binding *crt_binding;
96 
static binding *spare_binding = null ;
 127 
static binding *spare_binding = null;
97 
 
 128 
 
98 
 
 129 
 
99 
/*
 130 
/*
100 
    CREATE A NEW BINDING
 131 
    CREATE A NEW BINDING
101 
 
 132 
 
102 
    A new binding with space for no_var variable sorts is created and
 133 
    A new binding with space for no_var variable sorts is created and
103 
    cleared.
 134 
    cleared.
104 
*/
 135 
*/
105 
 
 136 
 
106 
static binding *new_binding
 137 
static binding *
107 
    PROTO_Z ()
 138 
new_binding(void)
108 
{
 139 
{
109 
    binding *b ;
 140 
    binding *b;
110 
    long i, n = no_var ;
 141 
    long i, n = no_var;
111 
    if ( n == 0 ) return ( null ) ;
 142 
    if (n == 0) return(null);
112 
    if ( spare_binding ) {
 143 
    if (spare_binding) {
113 
	b = spare_binding ;
 144 
	b = spare_binding;
114 
	spare_binding = null ;
 145 
	spare_binding = null;
115 
	for ( i = 0 ; i < n ; i++ ) b [i].max_no = 0 ;
 146 
	for (i = 0; i < n; i++)b[i].max_no = 0;
116 
	return ( b ) ;
 147 
	return(b);
117 
    }
 148 
    }
118 
    b = alloc_nof ( binding, n ) ;
 149 
    b = alloc_nof(binding, n);
119 
    for ( i = 0 ; i < n ; i++ ) {
 150 
    for (i = 0; i < n; i++) {
120 
	b [i].max_no = 0 ;
 151 
	b[i].max_no = 0;
121 
	b [i].sz = 0 ;
 152 
	b[i].sz = 0;
122 
	b [i].table = null ;
 153 
	b[i].table = null;
123 
    }
 154 
    }
124 
    return ( b ) ;
 155 
    return(b);
125 
}
 156 
}
126 
 
 157 
 
127 
 
 158 
 
128 
/*
 159 
/*
129 
    FREE A BINDING
 160 
    FREE A BINDING
130 
 
 161 
 
131 
    The binding b is returned to free.
 162 
    The binding b is returned to free.
132 
*/
 163 
*/
133 
 
 164 
 
134 
static void free_binding
 165 
static void
135 
    PROTO_N ( ( b ) )
 - 
 
136 
    PROTO_T ( binding *b )
 166 
free_binding(binding *b)
137 
{
 167 
{
138 
    spare_binding = b ;
 168 
    spare_binding = b;
139 
    return ;
 169 
    return;
140 
}
 170 
}
141 
 
 171 
 
142 
 
 172 
 
143 
/*
 173 
/*
144 
    SET THE SIZE OF AN ENTRY IN A BINDING
 174 
    SET THE SIZE OF AN ENTRY IN A BINDING
145 
 
 175 
 
146 
    The size of the table of the vth variable sort in the binding bt
 176 
    The size of the table of the vth variable sort in the binding bt
147 
    is set to n.
 177 
    is set to n.
148 
*/
 178 
*/
149 
 
 179 
 
150 
static void set_binding_size
 180 
static void
151 
    PROTO_N ( ( bt, v, n ) )
 - 
 
152 
    PROTO_T ( binding *bt X long v X long n )
 181 
set_binding_size(binding *bt, long v, long n)
153 
{
 182 
{
154 
    binding *b ;
 183 
    binding *b;
155 
    construct **p ;
 184 
    construct **p;
156 
    long i, m = n + 10 ;
 185 
    long i, m = n + 10;
157 
    if ( v < 0 || v >= no_var ) {
 186 
    if (v < 0 || v >= no_var) {
158 
	input_error ( "Illegal binding sort" ) ;
 187 
	input_error("Illegal binding sort");
159 
	return ;
 188 
	return;
160 
    }
 189 
    }
161 
    b = bt + v ;
 190 
    b = bt + v;
162 
    b->max_no = n ;
 191 
    b->max_no = n;
163 
    if ( b->sz < m ) {
 192 
    if (b->sz < m) {
164 
	p = realloc_nof ( b->table, construct *, m ) ;
 193 
	p = realloc_nof(b->table, construct *, m);
165 
	b->sz = m ;
 194 
	b->sz = m;
166 
	b->table = p ;
 195 
	b->table = p;
167 
    } else {
 196 
    } else {
168 
	p = b->table ;
 197 
	p = b->table;
169 
    }
 198 
    }
170 
    for ( i = 0 ; i < b->sz ; i++ ) p [i] = null ;
 199 
    for (i = 0; i < b->sz; i++)p[i] = null;
171 
    return ;
 200 
    return;
172 
}
 201 
}
173 
 
 202 
 
174 
 
 203 
 
175 
/*
 204 
/*
176 
    COMPLETE A BINDING
 205 
    COMPLETE A BINDING
177 
 
 206 
 
178 
    The unused entries in the binding b are filled in.
 207 
    The unused entries in the binding b are filled in.
179 
*/
 208 
*/
180 
 
 209 
 
181 
static void complete_binding
 210 
static void
182 
    PROTO_N ( ( b ) )
 - 
 
183 
    PROTO_T ( binding *b )
 211 
complete_binding(binding *b)
184 
{
 212 
{
185 
    long v ;
 213 
    long v;
186 
    for ( v = 0 ; v < no_var ; v++ ) {
 214 
    for (v = 0; v < no_var; v++) {
187 
	long i ;
 215 
	long i;
188 
	binding *bv = b + v ;
 216 
	binding *bv = b + v;
189 
	sortname s = vars [v].sortnum ;
 217 
	sortname s = vars[v].sortnum;
190 
	for ( i = 0 ; i < bv->max_no ; i++ ) {
 218 
	for (i = 0; i < bv->max_no; i++) {
191 
	    if ( bv->table [i] == null ) {
 219 
	    if (bv->table[i] == null) {
192 
		construct *p = make_construct ( s ) ;
 220 
		construct *p = make_construct(s);
193 
		if ( extract_tokdecs ) {
 221 
		if (extract_tokdecs) {
194 
		    /* This construct is unused - free it */
 222 
		    /* This construct is unused - free it */
195 
		    ( sort_count [s] )-- ;
 223 
		   (sort_count[s]) --;
196 
		    p->next = garbage ;
 224 
		    p->next = garbage;
197 
		    garbage = p ;
 225 
		    garbage = p;
198 
		} else {
 226 
		} else {
199 
		    /* Make up an internal name */
 227 
		    /* Make up an internal name */
200 
		    long n = p->encoding ;
 228 
		    long n = p->encoding;
201 
		    char *nm = alloc_nof ( char, 32 ) ;
 229 
		    char *nm = alloc_nof(char, 32);
202 
		    IGNORE sprintf ( nm, "~~%s_%ld", vars [v].name, n ) ;
 230 
		    IGNORE sprintf(nm, "~~%s_%ld", vars[v].name, n);
203 
		    p->name = nm ;
 231 
		    p->name = nm;
204 
		    if ( add_to_var_hash ( p, s ) ) {
 232 
		    if (add_to_var_hash(p, s)) {
205 
			input_error ( "%s has already been defined", nm ) ;
 233 
			input_error("%s has already been defined", nm);
206 
		    }
 234 
		    }
207 
		}
 235 
		}
208 
		bv->table [i] = p ;
 236 
		bv->table[i] = p;
209 
	    }
 237 
	    }
210 
	}
 238 
	}
211 
    }
 239 
    }
212 
    return ;
 240 
    return;
213 
}
 241 
}
214 
 
 242 
 
215 
 
 243 
 
216 
/*
 244 
/*
217 
    SET AN ENTRY IN A BINDING
 245 
    SET AN ENTRY IN A BINDING
218 
 
 246 
 
219 
    The nth entry of the vth variable sort of the binding bt is set to
 247 
    The nth entry of the vth variable sort of the binding bt is set to
220 
    the construct p.
 248 
    the construct p.
221 
*/
 249 
*/
222 
 
 250 
 
223 
static void set_binding
 251 
static void
224 
    PROTO_N ( ( bt, v, n, p ) )
 - 
 
225 
    PROTO_T ( binding *bt X long v X long n X construct *p )
 252 
set_binding(binding *bt, long v, long n, construct *p)
226 
{
 253 
{
227 
    binding *b ;
 254 
    binding *b;
228 
    if ( v < 0 || v >= no_var ) {
 255 
    if (v < 0 || v >= no_var) {
229 
	input_error ( "Illegal binding sort" ) ;
 256 
	input_error("Illegal binding sort");
230 
	return ;
 257 
	return;
231 
    }
 258 
    }
232 
    b = bt + v ;
 259 
    b = bt + v;
233 
    if ( n >= b->max_no || n < 0 ) {
 260 
    if (n >= b->max_no || n < 0) {
234 
	input_error ( "Object number %ld (%s) too big", n, vars [v].name ) ;
 261 
	input_error("Object number %ld (%s) too big", n, vars[v].name);
235 
	return ;
 262 
	return;
236 
    }
 263 
    }
237 
    if ( b->table [n] ) {
 264 
    if (b->table[n]) {
238 
	input_error ( "Object %ld (%s) already bound", n, vars [v].name ) ;
 265 
	input_error("Object %ld (%s) already bound", n, vars[v].name);
239 
	return ;
 266 
	return;
240 
    }
 267 
    }
241 
    b->table [n] = p ;
 268 
    b->table[n] = p;
242 
    return ;
 269 
    return;
243 
}
 270 
}
244 
 
 271 
 
245 
 
 272 
 
246 
/*
 273 
/*
247 
    FIND AN ENTRY IN A BINDING
 274 
    FIND AN ENTRY IN A BINDING
248 
 
 275 
 
249 
    The nth entry of the vth variable sort of the binding bt is returned.
 276 
    The nth entry of the vth variable sort of the binding bt is returned.
250 
*/
 277 
*/
251 
 
 278 
 
252 
construct *find_binding
 279 
construct *
253 
    PROTO_N ( ( bt, v, n ) )
 - 
 
254 
    PROTO_T ( binding *bt X long v X long n )
 280 
find_binding(binding *bt, long v, long n)
255 
{
 281 
{
256 
    binding *b ;
 282 
    binding *b;
257 
    if ( v < 0 || v >= no_var ) {
 283 
    if (v < 0 || v >= no_var) {
258 
	input_error ( "Illegal binding sort" ) ;
 284 
	input_error("Illegal binding sort");
259 
	return ( null ) ;
 285 
	return(null);
260 
    }
 286 
    }
261 
    b = bt + v ;
 287 
    b = bt + v;
262 
    if ( n >= b->max_no || n < 0 ) {
 288 
    if (n >= b->max_no || n < 0) {
263 
	input_error ( "Object number %ld (%s) too big", n, vars [v].name ) ;
 289 
	input_error("Object number %ld (%s) too big", n, vars[v].name);
264 
	return ( null ) ;
 290 
	return(null);
265 
    }
 291 
    }
266 
    return ( b->table [n] ) ;
 292 
    return(b->table[n]);
267 
}
 293 
}
268 
 
 294 
 
269 
 
 295 
 
270 
/*
 296 
/*
271 
    DECODE AN ALIGNED STRING
 297 
    DECODE AN ALIGNED STRING
272 
 
 298 
 
273 
    An aligned string (in an external name) is decoded and returned
 299 
    An aligned string (in an external name) is decoded and returned
274 
    as an array of characters.
 300 
    as an array of characters.
275 
*/
 301 
*/
276 
 
 302 
 
277 
char *de_aligned_string
 303 
static char *
278 
    PROTO_Z ()
 304 
de_aligned_string(void)
279 
{
 305 
{
280 
    char *p ;
 306 
    char *p;
281 
    long i, n = tdf_int () ;
 307 
    long i, n = tdf_int();
282 
    if ( n != 8 ) input_error ( "Only 8-bit strings allowed" ) ;
 308 
    if (n != 8)input_error("Only 8-bit strings allowed");
283 
    n = tdf_int () ;
 309 
    n = tdf_int();
284 
    byte_align () ;
 310 
    byte_align();
285 
    p = alloc_nof ( char, n + 1 ) ;
 311 
    p = alloc_nof(char, n + 1);
286 
    for ( i = 0 ; i < n ; i++ ) p [i] = ( char ) fetch ( 8 ) /* LINT */ ;
 312 
    for ( i = 0 ; i < n ; i++ ) p [i] = ( char ) fetch ( 8 ) /* LINT */ ;
287 
    p [n] = 0 ;
 313 
    p[n] = 0;
288 
    byte_align () ;
 314 
    byte_align();
289 
    return ( p ) ;
 315 
    return(p);
290 
}
 316 
}
291 
 
 317 
 
292 
 
 318 
 
293 
/*
 319 
/*
294 
    FLAG INDICATING SKIP PASS
 320 
    FLAG INDICATING SKIP PASS
295 
 
 321 
 
296 
    This flag is true if we are in the skip pass of a set of equations
 322 
    This flag is true if we are in the skip pass of a set of equations
297 
    (primarily token definitions).
 323 
    (primarily token definitions).
298 
*/
 324 
*/
299 
 
 325 
 
300 
boolean in_skip_pass = 0 ;
 326 
boolean in_skip_pass = 0;
301 
 
 327 
 
302 
 
 328 
 
303 
/*
 329 
/*
304 
    DECODE A SET OF EQUATIONS
 330 
    DECODE A SET OF EQUATIONS
305 
 
 331 
 
306 
    A set of equations with decoding routine f is decoded.  If f is null
 332 
    A set of equations with decoding routine f is decoded.  If f is null
307 
    the equations are stepped over, otherwise they are decoded.
 333 
    the equations are stepped over, otherwise they are decoded.
308 
*/
 334 
*/
309 
 
 335 
 
310 
typedef void ( *equation_func ) PROTO_S ( ( void ) ) ;
 336 
typedef void(*equation_func)(void);
311 
 
 337 
 
312 
static void de_equation
 338 
static void
313 
    PROTO_N ( ( f ) )
 - 
 
314 
    PROTO_T ( equation_func f )
 339 
de_equation(equation_func f)
315 
{
 340 
{
316 
    long i, n ;
 341 
    long i, n;
317 
    binding *old_binding = null ;
 342 
    binding *old_binding = null;
318 
 
 343 
 
319 
    /* Read new bindings */
 344 
    /* Read new bindings */
320 
    n = tdf_int () ;
 345 
    n = tdf_int();
321 
    if ( n ) {
 346 
    if (n) {
322 
	if ( n != no_var ) input_error ( "Number of local variables wrong" ) ;
 347 
	if (n != no_var)input_error("Number of local variables wrong");
323 
	old_binding = crt_binding ;
 348 
	old_binding = crt_binding;
324 
	crt_binding = new_binding () ;
 349 
	crt_binding = new_binding();
325 
	for ( i = 0 ; i < n ; i++ ) {
 350 
	for (i = 0; i < n; i++) {
326 
	    long sz = tdf_int () ;
 351 
	    long sz = tdf_int();
327 
	    set_binding_size ( crt_binding, i, sz ) ;
 352 
	    set_binding_size(crt_binding, i, sz);
328 
	}
 353 
	}
329 
	n = tdf_int () ;
 354 
	n = tdf_int();
330 
	if ( n != no_var ) input_error ( "Number of linkage units wrong" ) ;
 355 
	if (n != no_var)input_error("Number of linkage units wrong");
331 
	for ( i = 0 ; i < n ; i++ ) {
 356 
	for (i = 0; i < n; i++) {
332 
	    long j, no_links = tdf_int () ;
 357 
	    long j, no_links = tdf_int();
333 
	    for ( j = 0 ; j < no_links ; j++ ) {
 358 
	    for (j = 0; j < no_links; j++) {
334 
		long inner = tdf_int () ;
 359 
		long inner = tdf_int();
335 
		long outer = tdf_int () ;
 360 
		long outer = tdf_int();
336 
		construct *p = find_binding ( old_binding, i, outer ) ;
 361 
		construct *p = find_binding(old_binding, i, outer);
337 
		set_binding ( crt_binding, i, inner, p ) ;
 362 
		set_binding(crt_binding, i, inner, p);
338 
	    }
 363 
	    }
339 
	}
 364 
	}
340 
	complete_binding ( crt_binding ) ;
 365 
	complete_binding(crt_binding);
341 
    } else {
 366 
    } else {
342 
	n = tdf_int () ;
 367 
	n = tdf_int();
343 
	if ( n ) input_error ( "Number of linkage units wrong" ) ;
 368 
	if (n)input_error("Number of linkage units wrong");
344 
    }
 369 
    }
345 
 
 370 
 
346 
    /* Read the actual equation */
 371 
    /* Read the actual equation */
347 
    n = BYTESIZE * tdf_int () ;
 372 
    n = BYTESIZE * tdf_int();
348 
    byte_align () ;
 373 
    byte_align();
349 
    if ( f == null ) {
 374 
    if (f == null) {
350 
	input_skip ( n ) ;
 375 
	input_skip(n);
351 
    } else {
 376 
    } else {
352 
	long end_posn = input_posn () + n ;
 377 
	long end_posn = input_posn() + n;
353 
	decode_status = 2 ;
 378 
	decode_status = 2;
354 
	( *f ) () ;
 379 
	(*f)();
355 
	byte_align () ;
 380 
	byte_align();
356 
	decode_status = 1 ;
 381 
	decode_status = 1;
357 
	if ( input_posn () != end_posn ) input_error ( "Unit length wrong" ) ;
 382 
	if (input_posn()!= end_posn)input_error("Unit length wrong");
358 
    }
 383 
    }
359 
 
 384 
 
360 
    /* Restore the old bindings */
 385 
    /* Restore the old bindings */
361 
    if ( old_binding ) {
 386 
    if (old_binding) {
362 
	free_binding ( crt_binding ) ;
 387 
	free_binding(crt_binding);
363 
	crt_binding = old_binding ;
 388 
	crt_binding = old_binding;
364 
    }
 389 
    }
365 
    return ;
 390 
    return;
366 
}
 391 
}
367 
 
 392 
 
368 
 
 393 
 
369 
/*
 394 
/*
370 
    DECODE A CAPSULE
 395 
    DECODE A CAPSULE
371 
 
 396 
 
372 
    An entire TDF capsule is decoded.
 397 
    An entire TDF capsule is decoded.
373 
*/
 398 
*/
374 
 
 399 
 
375 
void de_capsule
 400 
void
376 
    PROTO_Z ()
 401 
de_capsule(void)
377 
{
 402 
{
378 
    long i, n ;
 403 
    long i, n;
379 
    long no_eqn ;
 404 
    long no_eqn;
380 
    char **eqns ;
 405 
    char **eqns;
381 
 
 406 
 
382 
    /* Reset variables */
 407 
    /* Reset variables */
383 
    al_tag_var = -1 ;
 408 
    al_tag_var = -1;
384 
    tag_var = -2 ;
 409 
    tag_var = -2;
385 
    tok_var = -3 ;
 410 
    tok_var = -3;
386 
    spare_binding = null ;
 411 
    spare_binding = null;
387 
    have_version = 0 ;
 412 
    have_version = 0;
388 
    decode_status = 0 ;
 413 
    decode_status = 0;
389 
 
 414 
 
390 
    /* Read magic number */
 415 
    /* Read magic number */
391 
    de_magic ( MAGIC_NUMBER ) ;
 416 
    de_magic(MAGIC_NUMBER);
392 
 
 417 
 
393 
    /* Read equation names */
 418 
    /* Read equation names */
394 
    no_eqn = tdf_int () ;
 419 
    no_eqn = tdf_int();
395 
    eqns = alloc_nof ( char *, no_eqn ) ;
 420 
    eqns = alloc_nof(char *, no_eqn);
396 
    for ( i = 0 ; i < no_eqn ; i++ ) eqns [i] = de_aligned_string () ;
 421 
    for (i = 0; i < no_eqn; i++)eqns[i] = de_aligned_string();
397 
 
 422 
 
398 
    /* Read variable sort names */
 423 
    /* Read variable sort names */
399 
    no_var = tdf_int () ;
 424 
    no_var = tdf_int();
400 
    vars = alloc_nof ( var_sort, no_var ) ;
 425 
    vars = alloc_nof(var_sort, no_var);
401 
    crt_binding = new_binding () ;
 426 
    crt_binding = new_binding();
402 
    for ( i = 0 ; i < no_var ; i++ ) {
 427 
    for (i = 0; i < no_var; i++) {
403 
	char *s = de_aligned_string () ;
 428 
	char *s = de_aligned_string();
404 
	long sz = tdf_int () ;
 429 
	long sz = tdf_int();
405 
	vars [i].name = s ;
 430 
	vars[i].name = s;
406 
	if ( streq ( s, LINK_al_tag ) ) {
 431 
	if (streq(s, LINK_al_tag)) {
407 
	    vars [i].sortnum = SORT_al_tag ;
 432 
	    vars[i].sortnum = SORT_al_tag;
408 
	    al_tag_var = i ;
 433 
	    al_tag_var = i;
409 
	} else if ( streq ( s, LINK_tag ) ) {
 434 
	} else if (streq(s, LINK_tag)) {
410 
	    vars [i].sortnum = SORT_tag ;
 435 
	    vars[i].sortnum = SORT_tag;
411 
	    tag_var = i ;
 436 
	    tag_var = i;
412 
	} else if ( streq ( s, LINK_token ) ) {
 437 
	} else if (streq(s, LINK_token)) {
413 
	    vars [i].sortnum = SORT_token ;
 438 
	    vars[i].sortnum = SORT_token;
414 
	    tok_var = i ;
 439 
	    tok_var = i;
415 
	} else {
 440 
	} else {
416 
	    vars [i].sortnum = SORT_unknown ;
 441 
	    vars[i].sortnum = SORT_unknown;
417 
	}
 442 
	}
418 
	set_binding_size ( crt_binding, i, sz ) ;
 443 
	set_binding_size(crt_binding, i, sz);
419 
    }
 444 
    }
420 
 
 445 
 
421 
    /* Read external names */
 446 
    /* Read external names */
422 
    decode_status = 1 ;
 447 
    decode_status = 1;
423 
    n = tdf_int () ;
 448 
    n = tdf_int();
424 
    if ( n != no_var ) input_error ( "Number of variable sorts wrong" ) ;
 449 
    if (n != no_var)input_error("Number of variable sorts wrong");
425 
    for ( i = 0 ; i < no_var ; i++ ) {
 450 
    for (i = 0; i < no_var; i++) {
426 
	static int un = 0 ;
 451 
	static int un = 0;
427 
	sortname si = vars [i].sortnum ;
 452 
	sortname si = vars[i].sortnum;
428 
	long j, no_links = tdf_int () ;
 453 
	long j, no_links = tdf_int();
429 
	boolean reject = 0 ;
 454 
	boolean reject = 0;
430 
	if ( extract_tokdecs && i != tok_var ) reject = 1 ;
 455 
	if (extract_tokdecs && i != tok_var)reject = 1;
431 
	for ( j = 0 ; j < no_links ; j++ ) {
 456 
	for (j = 0; j < no_links; j++) {
432 
	    construct *p, *q ;
 457 
	    construct *p, *q;
433 
	    long id = tdf_int () ;
 458 
	    long id = tdf_int();
434 
	    n = de_external_bits () ;
 459 
	    n = de_external_bits();
435 
	    byte_align () ;
 460 
	    byte_align();
436 
	    p = make_construct ( si ) ;
 461 
	    p = make_construct(si);
437 
	    if ( extract_tokdecs ) {
 462 
	    if (extract_tokdecs) {
438 
		( sort_count [ si ] )-- ;
 463 
		(sort_count[si]) --;
439 
		p->encoding = -1 ;
 464 
		p->encoding = -1;
440 
	    }
 465 
	    }
441 
 
 466 
 
442 
	    if ( n == ENC_string_extern ) {
 467 
	    if (n == ENC_string_extern) {
443 
		/* Simple external name */
 468 
		/* Simple external name */
444 
		boolean name_ok = 1 ;
 469 
		boolean name_ok = 1;
445 
		node *ns = de_node ( "=" ) ;
 470 
		node *ns = de_node("=");
446 
		if ( reject ) {
 471 
		if (reject) {
447 
		    free_node ( ns ) ;
 472 
		    free_node(ns);
448 
		} else {
 473 
		} else {
449 
		    /* Check that name is a valid identifier */
 474 
		    /* Check that name is a valid identifier */
450 
		    char *nm = ns->cons->name ;
 475 
		    char *nm = ns->cons->name;
451 
		    if ( alpha ( *nm ) ) {
 476 
		    if (alpha(*nm)) {
452 
			long k ;
 477 
			long k;
453 
			for ( k = 1 ; k < ns->cons->encoding ; k++ ) {
 478 
			for (k = 1; k < ns->cons->encoding; k++) {
454 
			    char c = nm [k] ;
 479 
			    char c = nm[k];
455 
			    if ( !alphanum ( c ) ) name_ok = 0 ;
 480 
			    if (!alphanum(c))name_ok = 0;
456 
			}
 481 
			}
457 
		    } else {
 482 
		    } else {
458 
			name_ok = 0 ;
 483 
			name_ok = 0;
459 
		    }
 484 
		    }
460 
		    if ( name_ok ) {
 485 
		    if (name_ok) {
461 
			/* Use external name as internal name */
 486 
			/* Use external name as internal name */
462 
			p->name = nm ;
 487 
			p->name = nm;
463 
			if ( !is_local_name ( nm ) ) {
 488 
			if (!is_local_name(nm)) {
464 
			    p->ename = new_node () ;
 489 
			    p->ename = new_node();
465 
			    p->ename->cons = &false_cons ;
 490 
			    p->ename->cons = &false_cons;
466 
			}
 491 
			}
467 
		    } else {
 492 
		    } else {
468 
			/* Make up internal name */
 493 
			/* Make up internal name */
469 
			p->name = alloc_nof ( char, 32 ) ;
 494 
			p->name = alloc_nof(char, 32);
470 
			IGNORE sprintf ( p->name, "~~extern_%d", un++ ) ;
 495 
			IGNORE sprintf(p->name, "~~extern_%d", un++);
471 
			if ( !is_local_name ( nm ) ) {
 496 
			if (!is_local_name(nm)) {
472 
			    p->ename = new_node () ;
 497 
			    p->ename = new_node();
473 
			    p->ename->cons = &true_cons ;
 498 
			    p->ename->cons = &true_cons;
474 
			    p->ename->son = ns ;
 499 
			    p->ename->son = ns;
475 
			}
 500 
			}
476 
		    }
 501 
		    }
477 
		}
 502 
		}
478 
	    } else if ( n == ENC_unique_extern ) {
 503 
	    } else if (n == ENC_unique_extern) {
479 
		/* Unique external name */
 504 
		/* Unique external name */
480 
		node *nu = de_node ( "%[=]" ) ;
 505 
		node *nu = de_node("%[=]");
481 
		if ( reject ) {
 506 
		if (reject) {
482 
		    free_node ( nu ) ;
 507 
		    free_node(nu);
483 
		} else {
 508 
		} else {
484 
		    /* Make up internal name */
 509 
		    /* Make up internal name */
485 
		    p->name = alloc_nof ( char, 32 ) ;
 510 
		    p->name = alloc_nof(char, 32);
486 
		    IGNORE sprintf ( p->name, "~~extern_%d", un++ ) ;
 511 
		    IGNORE sprintf(p->name, "~~extern_%d", un++);
487 
		    p->ename = new_node () ;
 512 
		    p->ename = new_node();
488 
		    p->ename->cons = &true_cons ;
 513 
		    p->ename->cons = &true_cons;
489 
		    p->ename->son = nu ;
 514 
		    p->ename->son = nu;
490 
		}
 515 
		}
491 
	    } else if ( n == ENC_chain_extern ) {
 516 
	    } else if (n == ENC_chain_extern) {
492 
		/* Chain external name */
 517 
		/* Chain external name */
493 
		node *nc = de_node ( "=i" ) ;
 518 
		node *nc = de_node("=i");
494 
		if ( reject ) {
 519 
		if (reject) {
495 
		    free_node ( nc ) ;
 520 
		    free_node(nc);
496 
		} else {
 521 
		} else {
497 
		    /* Make up internal name */
 522 
		    /* Make up internal name */
498 
		    p->name = alloc_nof ( char, 32 ) ;
 523 
		    p->name = alloc_nof(char, 32);
499 
		    IGNORE sprintf ( p->name, "~~extern_%d", un++ ) ;
 524 
		    IGNORE sprintf(p->name, "~~extern_%d", un++);
500 
		    p->ename = new_node () ;
 525 
		    p->ename = new_node();
501 
		    p->ename->cons = &true_cons ;
 526 
		    p->ename->cons = &true_cons;
502 
		    p->ename->son = nc ;
 527 
		    p->ename->son = nc;
503 
		}
 528 
		}
504 
	    } else {
 529 
	    } else {
505 
		input_error ( "Illegal EXTERN value, %ld", n ) ;
 530 
		input_error("Illegal EXTERN value, %ld", n);
506 
	    }
 531 
	    }
507 
 
 532 
 
508 
	    /* Add construct to tables */
 533 
	    /* Add construct to tables */
509 
	    if ( reject ) {
 534 
	    if (reject) {
510 
		set_binding ( crt_binding, i, id, p ) ;
 535 
		set_binding(crt_binding, i, id, p);
511 
		p->next = garbage ;
 536 
		p->next = garbage;
512 
		garbage = p ;
 537 
		garbage = p;
513 
	    } else {
 538 
	    } else {
514 
		q = add_to_var_hash ( p, si ) ;
 539 
		q = add_to_var_hash(p, si);
515 
		if ( q ) {
 540 
		if (q) {
516 
		    if ( !extract_tokdecs ) {
 541 
		    if (!extract_tokdecs) {
517 
			( sort_count [ si ] )-- ;
 542 
			(sort_count[si]) --;
518 
			if ( q->encoding == -1 ) {
 543 
			if (q->encoding == -1) {
519 
			    q->encoding = ( sort_count [ si ] )++ ;
 544 
			    q->encoding = (sort_count[si]) ++;
520 
			}
 545 
			}
521 
		    }
 546 
		    }
522 
		    set_binding ( crt_binding, i, id, q ) ;
 547 
		    set_binding(crt_binding, i, id, q);
523 
		    p->next = garbage ;
 548 
		    p->next = garbage;
524 
		    garbage = p ;
 549 
		    garbage = p;
525 
		} else {
 550 
		} else {
526 
		    set_binding ( crt_binding, i, id, p ) ;
 551 
		    set_binding(crt_binding, i, id, p);
527 
		}
 552 
		}
528 
	    }
 553 
	    }
529 
	}
 554 
	}
530 
    }
 555 
    }
531 
 
 556 
 
532 
    /* Complete the bindings */
 557 
    /* Complete the bindings */
533 
    complete_binding ( crt_binding ) ;
 558 
    complete_binding(crt_binding);
534 
 
 559 
 
535 
    /* Read the equations */
 560 
    /* Read the equations */
536 
    n = tdf_int () ;
 561 
    n = tdf_int();
537 
    if ( n != no_eqn ) input_error ( "Number of equations wrong" ) ;
 562 
    if (n != no_eqn)input_error("Number of equations wrong");
538 
    for ( i = 0 ; i < no_eqn ; i++ ) {
 563 
    for (i = 0; i < no_eqn; i++) {
539 
	char *eq = eqns [i] ;
 564 
	char *eq = eqns[i];
540 
	long j, no_units = tdf_int () ;
 565 
	long j, no_units = tdf_int();
541 
	if ( no_units ) {
 566 
	if (no_units) {
542 
	    boolean skip_pass = 0 ;
 567 
	    boolean skip_pass = 0;
543 
	    equation_func f = null ;
 568 
	    equation_func f = null;
544 
 
 569 
 
545 
	    /* Find equation decoding routine */
 570 
	    /* Find equation decoding routine */
546 
	    if ( extract_tokdecs ) {
 571 
	    if (extract_tokdecs) {
547 
		if ( streq ( eq, LINK_tokdec_props ) ) {
 572 
		if (streq(eq, LINK_tokdec_props)) {
548 
		    f = de_tokdec ;
 573 
		    f = de_tokdec;
549 
		} else if ( streq ( eq, LINK_tokdef_props ) ) {
 574 
		} else if (streq(eq, LINK_tokdef_props)) {
550 
		    f = de_tokdef ;
 575 
		    f = de_tokdef;
551 
		    in_skip_pass = 1 ;
 576 
		    in_skip_pass = 1;
552 
		}
 577 
		}
553 
	    } else {
 578 
	    } else {
554 
		if ( streq ( eq, LINK_al_tagdef_props ) ) {
 579 
		if (streq(eq, LINK_al_tagdef_props)) {
555 
		    f = de_aldef ;
 580 
		    f = de_aldef;
556 
		} else if ( streq ( eq, LINK_tagdec_props ) ) {
 581 
		} else if (streq(eq, LINK_tagdec_props)) {
557 
		    f = de_tagdec ;
 582 
		    f = de_tagdec;
558 
		} else if ( streq ( eq, LINK_tagdef_props ) ) {
 583 
		} else if (streq(eq, LINK_tagdef_props)) {
559 
		    f = de_tagdef ;
 584 
		    f = de_tagdef;
560 
		} else if ( streq ( eq, LINK_tokdec_props ) ) {
 585 
		} else if (streq(eq, LINK_tokdec_props)) {
561 
		    f = de_tokdec ;
 586 
		    f = de_tokdec;
562 
		} else if ( streq ( eq, LINK_tokdef_props ) ) {
 587 
		} else if (streq(eq, LINK_tokdef_props)) {
563 
		    f = de_tokdef ;
 588 
		    f = de_tokdef;
564 
		    skip_pass = 1 ;
 589 
		    skip_pass = 1;
565 
		} else if ( streq ( eq, LINK_version_props ) ) {
 590 
		} else if (streq(eq, LINK_version_props)) {
566 
		    f = de_version ;
 591 
		    f = de_version;
567 
		}
 592 
		}
568 
	    }
 593 
	    }
569 
 
 594 
 
570 
	    /* Skip pass */
 595 
	    /* Skip pass */
571 
	    if ( skip_pass ) {
 596 
	    if (skip_pass) {
572 
		long old_posn = input_posn () ;
 597 
		long old_posn = input_posn();
573 
		in_skip_pass = 1 ;
 598 
		in_skip_pass = 1;
574 
		for ( j = 0 ; j < no_units ; j++ ) de_equation ( f ) ;
 599 
		for (j = 0; j < no_units; j++)de_equation(f);
575 
		in_skip_pass = 0 ;
 600 
		in_skip_pass = 0;
576 
		input_goto ( old_posn ) ;
 601 
		input_goto(old_posn);
577 
	    }
 602 
	    }
578 
 
 603 
 
579 
	    /* Main pass */
 604 
	    /* Main pass */
580 
	    for ( j = 0 ; j < no_units ; j++ ) de_equation ( f ) ;
 605 
	    for (j = 0; j < no_units; j++)de_equation(f);
581 
	    in_skip_pass = 0 ;
 606 
	    in_skip_pass = 0;
582 
	}
 607 
	}
583 
    }
 608 
    }
584 
 
 609 
 
585 
    /* Free unused constructs */
 610 
    /* Free unused constructs */
586 
    free_construct ( &garbage ) ;
 611 
    free_construct(&garbage);
587 
    return ;
 612 
    return;
588 
}
 613 
}
589 
 
 614 
 
590 
 
 615 
 
591 
/*
 616 
/*
592 
    NAME OF CURRENT CAPSULE
 617 
    NAME OF CURRENT CAPSULE
593 
 
 618 
 
594 
    The current capsule of a library is recorded to use in error messages.
 619 
    The current capsule of a library is recorded to use in error messages.
595 
*/
 620 
*/
596 
 
 621 
 
597 
char *capname = null ;
 622 
char *capname = null;
598 
 
 623 
 
599 
 
 624 
 
600 
/*
 625 
/*
601 
    DECODE A TDF LIBRARY
 626 
    DECODE A TDF LIBRARY
602 
*/
 627 
*/
603 
 
 628 
 
604 
void de_library
 629 
void
605 
    PROTO_Z ()
 630 
de_library(void)
606 
{
 631 
{
607 
    long old_posn ;
 632 
    long old_posn;
608 
    long i, no_cap ;
 633 
    long i, no_cap;
609 
    boolean old_extract = extract_tokdecs ;
 634 
    boolean old_extract = extract_tokdecs;
610 
 
 635 
 
611 
    de_magic ( MAGIC_LINK_NUMBER ) ;
 636 
    de_magic(MAGIC_LINK_NUMBER);
612 
    IGNORE tdf_int () ;
 637 
    IGNORE tdf_int();
613 
    no_cap = tdf_int () ;
 638 
    no_cap = tdf_int();
614 
    old_posn = input_posn () ;
 639 
    old_posn = input_posn();
615 
 
 640 
 
616 
    /* First pass - extract all token declaration */
 641 
    /* First pass - extract all token declaration */
617 
    extract_tokdecs = 1 ;
 642 
    extract_tokdecs = 1;
618 
    for ( i = 0 ; i < no_cap ; i++ ) {
 643 
    for (i = 0; i < no_cap; i++) {
619 
	long end_posn ;
 644 
	long end_posn;
620 
	long j, n ;
 645 
	long j, n;
621 
	decode_status = 0 ;
 646 
	decode_status = 0;
622 
	n = tdf_int () ;
 647 
	n = tdf_int();
623 
	if ( n != 8 ) input_error ( "Only 8-bit strings allowed" ) ;
 648 
	if (n != 8)input_error("Only 8-bit strings allowed");
624 
	n = tdf_int () ;
 649 
	n = tdf_int();
625 
	byte_align () ;
 650 
	byte_align();
626 
	capname = alloc_nof ( char, n + 1 ) ;
 651 
	capname = alloc_nof(char, n + 1);
627 
	for ( j = 0 ; j < n ; j++ ) {
 652 
	for (j = 0; j < n; j++) {
628 
	    capname [j] = ( char ) fetch ( 8 ) ; /* LINT */
 653 
	    capname [j] = ( char ) fetch ( 8 ) ; /* LINT */
629 
	}
 654 
	}
630 
	capname [n] = 0 ;
 655 
	capname[n] = 0;
631 
	n = BYTESIZE * tdf_int () ;
 656 
	n = BYTESIZE * tdf_int();
632 
	byte_align () ;
 657 
	byte_align();
633 
	end_posn = input_posn () + n ;
 658 
	end_posn = input_posn() + n;
634 
	de_capsule () ;
 659 
	de_capsule();
635 
	byte_align () ;
 660 
	byte_align();
636 
	if ( input_posn () != end_posn ) {
 661 
	if (input_posn()!= end_posn) {
637 
	    input_error ( "Capsule length wrong" ) ;
 662 
	    input_error("Capsule length wrong");
638 
	}
 663 
	}
639 
	capname = null ;
 664 
	capname = null;
640 
    }
 665 
    }
641 
 
 666 
 
642 
    /* Second pass - if the first pass didn't do everything */
 667 
    /* Second pass - if the first pass didn't do everything */
643 
    extract_tokdecs = old_extract ;
 668 
    extract_tokdecs = old_extract;
644 
    if ( extract_tokdecs ) return ;
 669 
    if (extract_tokdecs) return;
645 
    input_goto ( old_posn ) ;
 670 
    input_goto(old_posn);
646 
    for ( i = 0 ; i < no_cap ; i++ ) {
 671 
    for (i = 0; i < no_cap; i++) {
647 
	long end_posn ;
 672 
	long end_posn;
648 
	long j, n ;
 673 
	long j, n;
649 
	decode_status = 0 ;
 674 
	decode_status = 0;
650 
	n = tdf_int () ;
 675 
	n = tdf_int();
651 
	if ( n != 8 ) input_error ( "Only 8-bit strings allowed" ) ;
 676 
	if (n != 8)input_error("Only 8-bit strings allowed");
652 
	n = tdf_int () ;
 677 
	n = tdf_int();
653 
	byte_align () ;
 678 
	byte_align();
654 
	capname = alloc_nof ( char, n + 1 ) ;
 679 
	capname = alloc_nof(char, n + 1);
655 
	for ( j = 0 ; j < n ; j++ ) {
 680 
	for (j = 0; j < n; j++) {
656 
	    capname [j] = ( char ) fetch ( 8 ) ; /* LINT */
 681 
	    capname [j] = ( char ) fetch ( 8 ) ; /* LINT */
657 
	}
 682 
	}
658 
	capname [n] = 0 ;
 683 
	capname[n] = 0;
659 
	n = BYTESIZE * tdf_int () ;
 684 
	n = BYTESIZE * tdf_int();
660 
	byte_align () ;
 685 
	byte_align();
661 
	end_posn = input_posn () + n ;
 686 
	end_posn = input_posn() + n;
662 
	de_capsule () ;
 687 
	de_capsule();
663 
	byte_align () ;
 688 
	byte_align();
664 
	if ( input_posn () != end_posn ) {
 689 
	if (input_posn()!= end_posn) {
665 
	    input_error ( "Capsule length wrong" ) ;
 690 
	    input_error("Capsule length wrong");
666 
	}
 691 
	}
667 
	capname = null ;
 692 
	capname = null;
668 
    }
 693 
    }
669 
    return ;
 694 
    return;
670 
}
 695 
}