Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/**********************************************************************
32 
$Author: release $
33 
$Date: 1998/01/17 15:55:45 $
34 
$Revision: 1.1.1.1 $
35 
$Log: read_fns.c,v $
36 
 * Revision 1.1.1.1  1998/01/17  15:55:45  release
37 
 * First version to be checked into rolling release.
38 
 *
39 
 * Revision 1.16  1998/01/09  09:24:58  pwe
40 
 * correct for dg_tags local to tagdef unit
41 
 *
42 
 * Revision 1.15  1997/12/04  19:49:59  pwe
43 
 * ANDF-DE V1.9
44 
 *
45 
 * Revision 1.14  1997/11/04  18:30:02  pwe
46 
 * ANDF-DE V1.8
47 
 *
48 
 * Revision 1.13  1997/08/23  13:30:47  pwe
49 
 * no invert order, and initial ANDF-DE
50 
 *
51 
 * Revision 1.12  1996/10/21  08:54:10  currie
52 
 * long_jump_access
53 
 *
54 
Revision 1.11  1996/06/17 15:30:45  currie
55 
tok signatures
56 
 
57 
Revision 1.10  1996/06/04 15:40:52  currie
58 
minor bug with repeated defs
59 
 
60 
Revision 1.9  1996/05/17 10:57:32  currie
61 
signature bug
62 
 
63 
 * Revision 1.8  1995/10/11  17:09:17  currie
64 
 * transfer token
65 
 *
66 
 * Revision 1.7  1995/09/27  12:39:49  currie
67 
 * Peters PIC code
68 
 *
69 
 * Revision 1.6  1995/09/15  13:28:09  currie
70 
 * add_prefix
71 
 *
72 
 * Revision 1.5  1995/09/11  15:36:20  currie
73 
 * gcc pedantry
74 
 *
75 
 * Revision 1.4  1995/06/22  09:21:10  currie
76 
 * Signatures on tokens
77 
 *
78 
 * Revision 1.3  1995/06/08  14:55:27  currie
79 
 * changes inherited from v3
80 
 *
81 
 * Revision 1.2  1995/05/05  08:12:13  currie
82 
 * initial_value + signtures
83 
 *
84 
 * Revision 1.1  1995/04/06  10:43:34  currie
85 
 * Initial revision
86 
 *
87 
***********************************************************************/
88 
 
89 
 
90 
 
91 
 
92 
/* this file contains the definitions of some of the functions
93 
   called from decoder.c to set up the in-store representations of TDF.
94 
   It defines those functions which are independent of the actual
95 
   representation, particularly the token substitution and
96 
   unit handling
97 
*/
98 
 
99 
 
100 
#include "config.h"
101 
#include "common_types.h"
102 
#include "basicread.h"
103 
#include "toktypes.h"
104 
#include "exp.h"
105 
#include "expmacs.h"
106 
#include "main_reads.h"
107 
#include "tags.h"
108 
#include "flags.h"
109 
#include "me_fns.h"
110 
#include "installglob.h"
111 
#include "readglob.h"
112 
#include "table_fns.h"
113 
#include "flpttypes.h"
114 
#include "flpt.h"
115 
#include "xalloc.h"
116 
#include "shapemacs.h"
117 
#include "read_fns.h"
118 
#include "sortmacs.h"
119 
#include "machine.h"
120 
#include "spec.h"
121 
#include "check.h"
122 
#include "aldefs.h"
123 
#include "externs.h"
124 
#include "diag_fns.h"	/* OLD DIAGS */
125 
#include "dg_fns.h"	/* NEW DIAGS */
126 
#include "messages_r.h"
127 
#include "natmacs.h"
128 
 
129 
 
130 
/* Some external declarations  */
131 
 
132 
extern diag_type_unit f_make_diagtype_unit PROTO_S ((void));	/* OLD DIAGS */
133 
extern int f_make_linkinfo_unit PROTO_S ((void));
134 
extern void start_make_linkinfo_unit PROTO_S ((int, int, int, int ));
135 
extern int machine_toks PROTO_S ((char *));
136 
extern void tidy_initial_values PROTO_S ((void));
137 
 
138 
/* MACROS */
139 
 
140 
    /* codes for the types of unit which are understood here */
141 
#define UNKNOWN_UNIT 0
142 
#define TOKDEC_UNIT 1
143 
#define TOKDEF_UNIT 2
144 
#define AL_UNIT 3
145 
#define TAGDEC_UNIT 4
146 
#define TAGDEF_UNIT 5
147 
#define DIAGDEF_UNIT 6		/* OLD DIAGS */
148 
#define DIAGTYPE_UNIT 7		/* OLD DIAGS */
149 
#define LINKINFO_UNIT 8
150 
#define VERSIONS_UNIT 9
151 
#define DGCOMP_UNIT 10		/* NEW DIAGS */
152 
 
153 
  /* codes for the kinds of linkable variable which are understood here */
154 
#define UNKNOWN_TYPE 0
155 
#define TOK_TYPE 1
156 
#define TAG_TYPE 2
157 
#define AL_TYPE 3
158 
#define DIAGTAG_TYPE 4		/* OLD DIAGS */
159 
#define DGTAG_TYPE 5		/* NEW DIAGS */
160 
 
161 
/* VARIABLES */
162 
/* All variables are initialised, jmf */
163 
 
164 
int crt_group_type;	 /* the code for the current group of units */
165 
int crt_links_type;/* the code for the current type of linkable variable                      */
166 
int crt_extern_link_type;/* the code for the current type of externally
167 
                             linked variable */
168 
tdfstring * crt_capsule_groups; /* the identifier for the current group
169 
                                   of units */
170 
int crt_capsule_group_no; /* the number in the group */
171 
int crt_capsule_link_no;  /* the number of linkable variables
172 
                               of the current type */
173 
capsule_link_list crt_capsule_linking;
174 
 
175 
static int no_of_local_tokens;
176 
 
177 
 
178 
 
179 
/* PROCEDURES */
180 
 
181 
  /* translates the name of a group of units into  its code */
182 
int group_type
183 
    PROTO_N ( (s) )
184 
    PROTO_T ( char * s )
185 
{
186 
  if (!strcmp(s, "tokdec"))
187 
    return TOKDEC_UNIT;
188 
  if (!strcmp(s, "tokdef"))
189 
    return TOKDEF_UNIT;
190 
  if (!strcmp(s, "aldef"))
191 
    return AL_UNIT;
192 
  if (!strcmp(s, "tagdec"))
193 
    return TAGDEC_UNIT;
194 
  if (!strcmp(s, "tagdef"))
195 
    return TAGDEF_UNIT;
196 
  if (!strcmp(s, "diagdef"))		/* OLD DIAGS */
197 
    return DIAGDEF_UNIT;
198 
  if (!strcmp(s, "diagtype"))		/* OLD DIAGS */
199 
    return DIAGTYPE_UNIT;
200 
  if (!strcmp(s, "linkinfo"))
201 
    return LINKINFO_UNIT;
202 
  if (!strcmp(s, "versions"))
203 
    return VERSIONS_UNIT;
204 
  if (!strcmp(s, "dgcompunit"))		/* NEW DIAGS */
205 
    return DGCOMP_UNIT;
206 
  return UNKNOWN_UNIT;
207 
}
208 
 
209 
  /* translates the name of a kind of linkable variable into its code */
210 
int links_type
211 
    PROTO_N ( (s) )
212 
    PROTO_T ( char * s )
213 
{
214 
  if (!strcmp(s, "token"))
215 
    return TOK_TYPE;
216 
  if (!strcmp(s, "tag"))
217 
    return TAG_TYPE;
218 
  if (!strcmp(s, "alignment"))
219 
    return AL_TYPE;
220 
  if (!strcmp(s, "diagtag"))		/* OLD DIAGS */
221 
    return DIAGTAG_TYPE;
222 
  if (!strcmp(s, "dgtag"))		/* NEW DIAGS */
223 
    return DGTAG_TYPE;
224 
  return UNKNOWN_TYPE;
225 
}
226 
 
227 
char * external_to_string
228 
    PROTO_N ( (ext) )
229 
    PROTO_T ( external ext )
230 
{
231 
	char * res;
232 
	int n, i, l;
233 
	tdfstring * t;
234 
	if (ext.isstring) {
235 
		return (char*)ext.ex.id.ints.chars;
236 
	}
237 
	else {
238 
		n = ext.ex.u.number;
239 
		t = ext.ex.u.elems;
240 
		l=n;
241 
		for(i=0; i<n; i++) l += t[i].number * (t[i].size / 8);
242 
		res = (char*)xcalloc(l+1, sizeof(char));
243 
		l = 0;
244 
		for(i=0; i<n; i++) {
245 
			IGNORE(strcpy(res+l, t[i].ints.chars));
246 
			l+= t[i].number * (t[i].size / 8);
247 
			res[l++] = 'U';
248 
		}
249 
		return res;
250 
	}
251 
}
252 
 
253 
 
254 
char * make_local_name
255 
    PROTO_Z ()
256 
{
257 
      /* invent a local label identifier */
258 
  char *id;
259 
  char *st = intchars (next_lab ());
260 
  int   l = (int)strlen (st);
261 
  int lpl = (int)strlen(local_prefix);
262 
  id = (char *) xcalloc (l + lpl + 1, sizeof (char));
263 
  IGNORE strcpy(id, local_prefix);
264 
  IGNORE strcpy(&id[lpl], st);
265 
  return id;
266 
}
267 
 
268 
static void check_tok_sig
269 
    PROTO_N ( (t, sig) )
270 
    PROTO_T ( tok_define * t X string sig )
271 
{
272 
	char * sid = sig.ints.chars;
273 
	int s = (sig.size*sig.number)/8;
274 
	if (t->signature != (char*)0) {
275 
		char * id = t->signature;
276 
			    	int i;
277 
		for(i=0; i<s; i++) {
278 
			if (id[i]!=sid[i]) break;
279 
		}
280 
		if (i!=s || id[s] !=0) {
281 
			   IGNORE fprintf(stderr, "%s\n%s\n", id, sid);
282 
			   failer("Token signatures should be equal");
283 
		}
284 
	}
285 
	else {
286 
		t->signature = sid;
287 
	}
288 
}
289 
 
290 
  /* all the _apply_token functions follow this pattern */
291 
procprops f_procprops_apply_token
292 
    PROTO_N ( (token_value, token_args) )
293 
    PROTO_T ( token token_value X bitstream token_args )
294 
{
295 
   tokval v;
296 
   v = apply_tok(token_value, token_args, PROCPROPS, (tokval*)0);
297 
   return v.tk_procprops;
298 
}
299 
 
300 
  /* all the _cond functions follow this pattern */
301 
procprops f_procprops_cond
302 
    PROTO_N ( (control, e1, e2) )
303 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
304 
{
305 
  bitstream bs;
306 
  procprops res;
307 
  int n;
308 
  bs = keep_place();
309 
 
310 
    /* the control must evaluate to a constant */
311 
  if (name(control) != val_tag)
312 
    failer(CONTROL_EXP);
313 
  n = no(control);
314 
  retcell(control);
315 
  if (n==0)
316 
   {
317 
      /* use the second bitstream */
318 
     set_place(e2);
319 
     res = d_procprops();
320 
   }
321 
  else
322 
   {
323 
      /* use the first bitstream */
324 
     set_place(e1);
325 
     res = d_procprops();
326 
   };
327 
 set_place(bs);
328 
 return res;
329 
}
330 
 
331 
string f_string_apply_token
332 
    PROTO_N ( (token_value, token_args) )
333 
    PROTO_T ( token token_value X bitstream token_args )
334 
{
335 
   tokval v;
336 
   v = apply_tok(token_value, token_args, STRING, (tokval*)0);
337 
   return v.tk_string;
338 
}
339 
 
340 
  /* all the _cond functions follow this pattern */
341 
string f_string_cond
342 
    PROTO_N ( (control, e1, e2) )
343 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
344 
{
345 
  bitstream bs;
346 
  string res;
347 
  int n;
348 
  bs = keep_place();
349 
 
350 
    /* the control must evaluate to a constant */
351 
  if (name(control) != val_tag)
352 
    failer(CONTROL_EXP);
353 
  n = no(control);
354 
  retcell(control);
355 
  if (n==0)
356 
   {
357 
      /* use the second bitstream */
358 
     set_place(e2);
359 
     res = d_string();
360 
   }
361 
  else
362 
   {
363 
      /* use the first bitstream */
364 
     set_place(e1);
365 
     res = d_string();
366 
   };
367 
 set_place(bs);
368 
 return res;
369 
}
370 
 
371 
 
372 
alignment f_alignment_apply_token
373 
    PROTO_N ( (token_value, token_args) )
374 
    PROTO_T ( token token_value X bitstream token_args )
375 
{
376 
   tokval v;
377 
   v = apply_tok(token_value, token_args, ALIGNMENT_SORT, (tokval*)0);
378 
   return v.tk_alignment;
379 
}
380 
 
381 
  /* all the _cond functions follow this pattern */
382 
alignment f_alignment_cond
383 
    PROTO_N ( (control, e1, e2) )
384 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
385 
{
386 
  bitstream bs;
387 
  alignment res;
388 
  int n;
389 
  bs = keep_place();
390 
 
391 
    /* the control must evaluate to a constant */
392 
  if (name(control) != val_tag)
393 
    failer(CONTROL_EXP);
394 
  n = no(control);
395 
  retcell(control);
396 
  if (n==0)
397 
   {
398 
      /* use the second bitstream */
399 
     set_place(e2);
400 
     res = d_alignment();
401 
   }
402 
  else
403 
   {
404 
      /* use the first bitstream */
405 
     set_place(e1);
406 
     res = d_alignment();
407 
   };
408 
 set_place(bs);
409 
 return res;
410 
}
411 
 
412 
access f_access_apply_token
413 
    PROTO_N ( (token_value, token_args) )
414 
    PROTO_T ( token token_value X bitstream token_args )
415 
{
416 
   tokval v;
417 
   v = apply_tok(token_value, token_args, ACCESS_SORT, (tokval*)0);
418 
   return v.tk_access;
419 
}
420 
 
421 
 
422 
access f_access_cond
423 
    PROTO_N ( (control, e1, e2) )
424 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
425 
{
426 
  bitstream bs;
427 
  access res;
428 
  int n;
429 
  bs = keep_place();
430 
 
431 
    /* the control must evaluate to a constant */
432 
  if (name(control) != val_tag)
433 
    failer(CONTROL_EXP);
434 
  n = no(control);
435 
  retcell(control);
436 
  if (n==0)
437 
   {
438 
      /* use the second bitstream */
439 
     set_place(e2);
440 
     res = d_access();
441 
   }
442 
  else
443 
   {
444 
      /* use the first bitstream */
445 
     set_place(e1);
446 
     res = d_access();
447 
   };
448 
 set_place(bs);
449 
 return res;
450 
}
451 
 
452 
transfer_mode f_transfer_mode_apply_token
453 
    PROTO_N ( (token_value, token_args) )
454 
    PROTO_T ( token token_value X bitstream token_args )
455 
{
456 
   tokval v;
457 
   v = apply_tok(token_value, token_args, TRANSFER_MODE_SORT, (tokval*)0);
458 
   return v.tk_transfer_mode;
459 
}
460 
 
461 
 
462 
transfer_mode f_transfer_mode_cond
463 
    PROTO_N ( (control, e1, e2) )
464 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
465 
{
466 
  bitstream bs;
467 
  transfer_mode res;
468 
  int n;
469 
  bs = keep_place();
470 
 
471 
    /* the control must evaluate to a constant */
472 
  if (name(control) != val_tag)
473 
    failer(CONTROL_EXP);
474 
  n = no(control);
475 
  retcell(control);
476 
  if (n==0)
477 
   {
478 
      /* use the second bitstream */
479 
     set_place(e2);
480 
     res = d_transfer_mode();
481 
   }
482 
  else
483 
   {
484 
      /* use the first bitstream */
485 
     set_place(e1);
486 
     res = d_transfer_mode();
487 
   };
488 
 set_place(bs);
489 
 return res;
490 
}
491 
 
492 
 
493 
bitfield_variety f_bfvar_apply_token
494 
    PROTO_N ( (token_value, token_args) )
495 
    PROTO_T ( token token_value X bitstream token_args )
496 
{
497 
   tokval v;
498 
   v = apply_tok(token_value, token_args, BITFIELD_VARIETY, (tokval*)0);
499 
   return v.tk_bitfield_variety;
500 
}
501 
 
502 
bitfield_variety f_bfvar_cond
503 
    PROTO_N ( (control, e1, e2) )
504 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
505 
{
506 
  bitstream bs;
507 
  bitfield_variety res;
508 
  int n;
509 
  bs = keep_place();
510 
  if (name(control) != val_tag)
511 
    failer(CONTROL_EXP);
512 
  n = no(control);
513 
  retcell(control);
514 
  if (n==0)
515 
   {
516 
     set_place(e2);
517 
     res = d_bitfield_variety();
518 
   }
519 
  else
520 
   {
521 
     set_place(e1);
522 
     res = d_bitfield_variety();
523 
   };
524 
 set_place(bs);
525 
 return res;
526 
}
527 
 
528 
bool f_bool_apply_token
529 
    PROTO_N ( (token_value, token_args) )
530 
    PROTO_T ( token token_value X bitstream token_args )
531 
{
532 
   tokval v;
533 
   v = apply_tok(token_value, token_args, BOOL, (tokval*)0);
534 
   return v.tk_bool;
535 
}
536 
 
537 
bool f_bool_cond
538 
    PROTO_N ( (control, e1, e2) )
539 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
540 
{
541 
  bitstream bs;
542 
  bool res;
543 
  int n;
544 
  bs = keep_place();
545 
  if (name(control) != val_tag)
546 
    failer(CONTROL_EXP);
547 
  n = no(control);
548 
  retcell(control);
549 
  if (n==0)
550 
   {
551 
     set_place(e2);
552 
     res = d_bool();
553 
   }
554 
  else
555 
   {
556 
     set_place(e1);
557 
     res = d_bool();
558 
   };
559 
 set_place(bs);
560 
 return res;
561 
}
562 
 
563 
 
564 
  /* locate the index number of the linkable variable */
565 
int find_index
566 
    PROTO_N ( (nm) )
567 
    PROTO_T ( char * nm )
568 
{
569 
  int i;
570 
  for (i=0; i < crt_capsule_linking.number; ++i)
571 
   {
572 
     if (!strcmp((crt_capsule_linking.members[i]).id, nm))
573 
        return i;
574 
   };
575 
  return -1;
576 
}
577 
 
578 
 
579 
void start_make_capsule
580 
    PROTO_N ( (prop_names, capsule_linking) )
581 
    PROTO_T ( tdfstring_list prop_names X capsule_link_list capsule_linking )
582 
{
583 
  int i;
584 
 
585 
  while (capsule_freelist) {
586 
    capsule_frees * cf = capsule_freelist -> next;
587 
    xfree((void*)capsule_freelist->ptr);
588 
    xfree((void*)capsule_freelist);
589 
    capsule_freelist = cf;
590 
  };
591 
 
592 
  crt_tagdef_unit_no = -1;
593 
  unit_index = 0;
594 
  top_aldef = (aldef *)0;
595 
  doing_aldefs = 0;
596 
 
597 
  crt_capsule_groups = prop_names.elems;
598 
  crt_capsule_group_no = prop_names.number;
599 
 
600 
  crt_capsule_linking = capsule_linking;
601 
  crt_capsule_link_no = capsule_linking.number;
602 
 
603 
  i = find_index("token");
604 
  capsule_no_of_tokens = (i == -1) ? 0 :
605 
               natint((capsule_linking.members[i]).n);
606 
 
607 
  i = find_index("tag");
608 
  capsule_no_of_tags = (i == -1) ? 0 :
609 
               natint((capsule_linking.members[i]).n);
610 
 
611 
  i = find_index("alignment");
612 
  capsule_no_of_als = (i == -1) ? 0 :
613 
               natint((capsule_linking.members[i]).n);
614 
 
615 
  i = find_index("diagtag");		/* OLD DIAGS */
616 
  capsule_no_of_diagtags = (i == -1) ? 0 :
617 
               natint((capsule_linking.members[i]).n);
618 
 
619 
  i = find_index("dgtag");		/* NEW DIAGS */
620 
  capsule_no_of_dgtags = (i == -1) ? 0 :
621 
               natint((capsule_linking.members[i]).n);
622 
 
623 
  capsule_toktab = (tok_define*)xcalloc(capsule_no_of_tokens,
624 
                          sizeof(tok_define));
625 
  capsule_tagtab = (dec*)xcalloc(capsule_no_of_tags, sizeof(dec));
626 
  capsule_altab = (aldef*)xcalloc(capsule_no_of_als, sizeof(aldef));
627 
  capsule_diag_tagtab = (diag_tagdef*)xcalloc(capsule_no_of_diagtags,
628 
                                         sizeof(diag_tagdef));	/* OLD DIAGS */
629 
  capsule_dgtab = (dgtag_struct*)xcalloc(capsule_no_of_dgtags,
630 
                                         sizeof(dgtag_struct));	/* NEW DIAGS */
631 
 
632 
  for (i = 0; i < capsule_no_of_tokens; ++i) {
633 
        /* initialise the table of tokens */
634 
    tok_define * tp = &capsule_toktab[i];
635 
    tp -> tok_special = 0;
636 
    tp -> valpresent = 0;
637 
    tp -> unit_number = crt_tagdef_unit_no;
638 
    tp -> defined = 0;
639 
    tp -> tok_index = i;
640 
    tp -> is_capsule_token = 1;
641 
    tp -> recursive = 0;
642 
  };
643 
 
644 
  for (i = 0; i < capsule_no_of_tags; ++i) {
645 
        /* initialise the table of tags */
646 
    dec * dp = &capsule_tagtab[i];
647 
    dp -> dec_u.dec_val.dec_outermost = 0;
648 
    dp -> dec_u.dec_val.dec_id = (char *) 0;
649 
    dp -> dec_u.dec_val.extnamed = 0;
650 
    dp -> dec_u.dec_val.diag_info = (diag_global *)0;
651 
    dp -> dec_u.dec_val.have_def = 0;
652 
    dp -> dec_u.dec_val.dec_shape = nilexp;
653 
    dp -> dec_u.dec_val.processed = 0;
654 
    dp -> dec_u.dec_val.isweak = 0;
655 
  };
656 
 
657 
  for (i = 0; i < capsule_no_of_als; ++i) {
658 
        /* initialise the table of alignment tags */
659 
    aldef * ap = &capsule_altab[i];
660 
    ap -> al.al_n = 0;
661 
  };
662 
 
663 
  init_capsule_diagtags();	/* OLD DIAGS */
664 
  init_capsule_dgtags();	/* NEW DIAGS */
665 
 
666 
  return;
667 
}
668 
 
669 
capsule f_make_capsule
670 
    PROTO_N ( (prop_names, capsule_linking, external_linkage, units) )
671 
    PROTO_T ( tdfstring_list prop_names X capsule_link_list capsule_linking X
672 
	      extern_link_list external_linkage X unit_list units )
673 
{
674 
  UNUSED(prop_names); UNUSED(capsule_linking);
675 
  UNUSED(external_linkage);UNUSED(units);
676 
 
677 
  translate_capsule();
678 
  return 0;
679 
}
680 
 
681 
void init_capsule
682 
    PROTO_Z ()
683 
{
684 
  return;
685 
}
686 
 
687 
capsule_link f_make_capsule_link
688 
    PROTO_N ( (sn, n) )
689 
    PROTO_T ( tdfstring sn X tdfint n )
690 
{
691 
  capsule_link res;
692 
  res.n = n;
693 
  res.id = (char*)sn.ints.chars;
694 
  return res;
695 
}
696 
 
697 
error_treatment f_errt_apply_token
698 
    PROTO_N ( (token_value, token_args) )
699 
    PROTO_T ( token token_value X bitstream token_args )
700 
{
701 
   tokval v;
702 
   v = apply_tok(token_value, token_args, ERROR_TREATMENT, (tokval*)0);
703 
   return v.tk_error_treatment;
704 
}
705 
 
706 
error_treatment f_errt_cond
707 
    PROTO_N ( (control, e1, e2) )
708 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
709 
{
710 
  bitstream bs;
711 
  error_treatment res;
712 
  int n;
713 
  bs = keep_place();
714 
  if (name(control) != val_tag)
715 
    failer(CONTROL_EXP);
716 
  n = no(control);
717 
  retcell(control);
718 
  if (n==0)
719 
   {
720 
     set_place(e2);
721 
     res = d_error_treatment();
722 
   }
723 
  else
724 
   {
725 
     set_place(e1);
726 
     res = d_error_treatment();
727 
   };
728 
 set_place(bs);
729 
 return res;
730 
}
731 
 
732 
 
733 
exp f_exp_apply_token
734 
    PROTO_N ( (token_value, token_args) )
735 
    PROTO_T ( token token_value X bitstream token_args )
736 
{
737 
   tokval v;
738 
   v = apply_tok(token_value, token_args, EXP_S, (tokval*)0);
739 
   return v.tk_exp;
740 
}
741 
 
742 
exp f_exp_cond
743 
    PROTO_N ( (control, e1, e2) )
744 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
745 
{
746 
  bitstream bs;
747 
  exp res;
748 
  int n;
749 
  bs = keep_place();
750 
  if (name(control) != val_tag)
751 
    failer(CONTROL_EXP);
752 
  n = no(control);
753 
  retcell(control);
754 
  if (n==0)
755 
   {
756 
     set_place(e2);
757 
     res = d_exp();
758 
   }
759 
  else
760 
   {
761 
     set_place(e1);
762 
     res = d_exp();
763 
   };
764 
 set_place(bs);
765 
 return res;
766 
}
767 
 
768 
external f_string_extern
769 
    PROTO_N ( (s) )
770 
    PROTO_T ( tdfstring s )
771 
{
772 
  external e;
773 
  e.isstring = 1;
774 
  e.ex.id = s;
775 
  return e;
776 
}
777 
 
778 
external f_unique_extern
779 
    PROTO_N ( (u) )
780 
    PROTO_T ( unique u )
781 
{
782 
  external e;
783 
  e.isstring = 0;
784 
  e.ex.u = u;
785 
  return e;
786 
}
787 
 
788 
external f_chain_extern
789 
    PROTO_N ( (s, i) )
790 
    PROTO_T ( tdfstring s X tdfint i )
791 
{
792 
	UNUSED (s);
793 
	UNUSED (i);
794 
	failer("chain_extern not yet done");
795 
	return f_dummy_external;
796 
}
797 
 
798 
void init_external
799 
    PROTO_Z ()
800 
{
801 
  return;
802 
}
803 
 
804 
external f_dummy_external;
805 
 
806 
floating_variety f_flvar_apply_token
807 
    PROTO_N ( (token_value, token_args) )
808 
    PROTO_T ( token token_value X bitstream token_args )
809 
{
810 
   tokval v;
811 
   v = apply_tok(token_value, token_args, FLOATING_VARIETY, (tokval*)0);
812 
   return v.tk_floating_variety;
813 
}
814 
 
815 
floating_variety f_flvar_cond
816 
    PROTO_N ( (control, e1, e2) )
817 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
818 
{
819 
  bitstream bs;
820 
  floating_variety res;
821 
  int n;
822 
  bs = keep_place();
823 
  if (name(control) != val_tag)
824 
    failer(CONTROL_EXP);
825 
  n = no(control);
826 
  retcell(control);
827 
  if (n==0)
828 
   {
829 
     set_place(e2);
830 
     res = d_floating_variety();
831 
   }
832 
  else
833 
   {
834 
     set_place(e1);
835 
     res = d_floating_variety();
836 
   };
837 
 set_place(bs);
838 
 return res;
839 
}
840 
 
841 
 
842 
label f_label_apply_token
843 
    PROTO_N ( (token_value, token_args) )
844 
    PROTO_T ( token token_value X bitstream token_args )
845 
{
846 
   tokval v;
847 
   v = apply_tok(token_value, token_args, LABEL, (tokval*)0);
848 
   return v.tk_label;
849 
}
850 
 
851 
label f_make_label
852 
    PROTO_N ( (labelno) )
853 
    PROTO_T ( tdfint labelno )
854 
{
855 
  return &unit_labtab[natint(labelno)];
856 
}
857 
 
858 
void init_label
859 
    PROTO_Z ()
860 
{
861 
  return;
862 
}
863 
 
864 
label f_dummy_label;
865 
 
866 
nat f_nat_apply_token
867 
    PROTO_N ( (token_value, token_args) )
868 
    PROTO_T ( token token_value X bitstream token_args )
869 
{
870 
   tokval v;
871 
   v = apply_tok(token_value, token_args, NAT, (tokval*)0);
872 
   return v.tk_nat;
873 
}
874 
 
875 
nat f_nat_cond
876 
    PROTO_N ( (control, e1, e2) )
877 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
878 
{
879 
  bitstream bs;
880 
  nat res;
881 
  int n;
882 
  bs = keep_place();
883 
  if (name(control) != val_tag)
884 
    failer(CONTROL_EXP);
885 
  n = no(control);
886 
  retcell(control);
887 
  if (n==0)
888 
   {
889 
     set_place(e2);
890 
     res = d_nat();
891 
   }
892 
  else
893 
   {
894 
     set_place(e1);
895 
     res = d_nat();
896 
   };
897 
 set_place(bs);
898 
 return res;
899 
}
900 
 
901 
ntest f_ntest_apply_token
902 
    PROTO_N ( (token_value, token_args) )
903 
    PROTO_T ( token token_value X bitstream token_args )
904 
{
905 
   tokval v;
906 
   v = apply_tok(token_value, token_args, NTEST, (tokval*)0);
907 
   return v.tk_ntest;
908 
}
909 
 
910 
ntest f_ntest_cond
911 
    PROTO_N ( (control, e1, e2) )
912 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
913 
{
914 
  bitstream bs;
915 
  ntest res;
916 
  int n;
917 
  bs = keep_place();
918 
  if (name(control) != val_tag)
919 
    failer(CONTROL_EXP);
920 
  n = no(control);
921 
  retcell(control);
922 
  if (n==0)
923 
   {
924 
     set_place(e2);
925 
     res = d_ntest();
926 
   }
927 
  else
928 
   {
929 
     set_place(e1);
930 
     res = d_ntest();
931 
   };
932 
 set_place(bs);
933 
 return res;
934 
}
935 
 
936 
rounding_mode f_rounding_mode_apply_token
937 
    PROTO_N ( (token_value, token_args) )
938 
    PROTO_T ( token token_value X bitstream token_args )
939 
{
940 
   tokval v;
941 
   v = apply_tok(token_value, token_args, ROUNDING_MODE, (tokval*)0);
942 
   return v.tk_rounding_mode;
943 
}
944 
 
945 
rounding_mode f_rounding_mode_cond
946 
    PROTO_N ( (control, e1, e2) )
947 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
948 
{
949 
  bitstream bs;
950 
  rounding_mode res;
951 
  int n;
952 
  bs = keep_place();
953 
  if (name(control) != val_tag)
954 
    failer(CONTROL_EXP);
955 
  n = no(control);
956 
  retcell(control);
957 
  if (n==0)
958 
   {
959 
     set_place(e2);
960 
     res = d_rounding_mode();
961 
   }
962 
  else
963 
   {
964 
     set_place(e1);
965 
     res = d_rounding_mode();
966 
   };
967 
 set_place(bs);
968 
 return res;
969 
}
970 
 
971 
shape f_shape_apply_token
972 
    PROTO_N ( (token_value, token_args) )
973 
    PROTO_T ( token token_value X bitstream token_args )
974 
{
975 
   tokval v;
976 
   v = apply_tok(token_value, token_args, SHAPE, (tokval*)0);
977 
   return v.tk_shape;
978 
}
979 
 
980 
shape f_shape_cond
981 
    PROTO_N ( (control, e1, e2) )
982 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
983 
{
984 
  bitstream bs;
985 
  shape res;
986 
  int n;
987 
  bs = keep_place();
988 
  if (name(control) != val_tag)
989 
    failer(CONTROL_EXP);
990 
  n = no(control);
991 
  retcell(control);
992 
  if (n==0)
993 
   {
994 
     set_place(e2);
995 
     res = d_shape();
996 
   }
997 
  else
998 
   {
999 
     set_place(e1);
1000 
     res = d_shape();
1001 
   };
1002 
 set_place(bs);
1003 
 return res;
1004 
}
1005 
 
1006 
signed_nat f_signed_nat_apply_token
1007 
    PROTO_N ( (token_value, token_args) )
1008 
    PROTO_T ( token token_value X bitstream token_args )
1009 
{
1010 
   tokval v;
1011 
   v = apply_tok(token_value, token_args, SIGNED_NAT, (tokval*)0);
1012 
   return v.tk_signed_nat;
1013 
}
1014 
 
1015 
signed_nat f_signed_nat_cond
1016 
    PROTO_N ( (control, e1, e2) )
1017 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
1018 
{
1019 
  bitstream bs;
1020 
  signed_nat res;
1021 
  int n;
1022 
  bs = keep_place();
1023 
  if (name(control) != val_tag)
1024 
    failer(CONTROL_EXP);
1025 
  n = no(control);
1026 
  retcell(control);
1027 
  if (n==0)
1028 
   {
1029 
     set_place(e2);
1030 
     res = d_signed_nat();
1031 
   }
1032 
  else
1033 
   {
1034 
     set_place(e1);
1035 
     res = d_signed_nat();
1036 
   };
1037 
 set_place(bs);
1038 
 return res;
1039 
 
1040 
}
1041 
 
1042 
 
1043 
sortname f_alignment_sort;
1044 
sortname f_bitfield_variety;
1045 
sortname f_bool;
1046 
sortname f_error_treatment;
1047 
sortname f_exp;
1048 
sortname f_floating_variety;
1049 
sortname f_label;
1050 
sortname f_nat;
1051 
sortname f_ntest;
1052 
sortname f_rounding_mode;
1053 
sortname f_shape;
1054 
sortname f_signed_nat;
1055 
sortname f_tag;
1056 
sortname f_al_tag;
1057 
sortname f_diag_filename;	/* OLD DIAGS */
1058 
sortname f_diag_type;		/* OLD DIAGS */
1059 
sortname f_foreign;
1060 
sortname f_access;
1061 
sortname f_transfer_mode;
1062 
sortname f_procprops;
1063 
sortname f_string;
1064 
sortname f_dg;			/* NEW DIAGS */
1065 
sortname f_dg_dim;		/* NEW DIAGS */
1066 
sortname f_dg_filename;		/* NEW DIAGS */
1067 
sortname f_dg_idname;		/* NEW DIAGS */
1068 
sortname f_dg_name;		/* NEW DIAGS */
1069 
sortname f_dg_type;		/* NEW DIAGS */
1070 
 
1071 
sortname f_foreign_sort
1072 
    PROTO_N ( (foreign_name) )
1073 
    PROTO_T ( tdfstring foreign_name )
1074 
{
1075 
  if (!strcmp(foreign_name.ints.chars, "~diag_file"))	/* OLD DIAGS */
1076 
    return f_diag_filename;
1077 
  if (!strcmp(foreign_name.ints.chars, "~diag_type"))	/* OLD DIAGS */
1078 
    return f_diag_type;
1079 
  if (!strcmp(foreign_name.ints.chars, "DG"))		/* NEW DIAGS */
1080 
    return f_dg;
1081 
  if (!strcmp(foreign_name.ints.chars, "DG_DIM"))	/* NEW DIAGS */
1082 
    return f_dg_dim;
1083 
  if (!strcmp(foreign_name.ints.chars, "DG_FILENAME"))	/* NEW DIAGS */
1084 
    return f_dg_filename;
1085 
  if (!strcmp(foreign_name.ints.chars, "DG_IDNAME"))	/* NEW DIAGS */
1086 
    return f_dg_idname;
1087 
  if (!strcmp(foreign_name.ints.chars, "DG_NAME"))	/* NEW DIAGS */
1088 
    return f_dg_name;
1089 
  if (!strcmp(foreign_name.ints.chars, "DG_TYPE"))	/* NEW DIAGS */
1090 
    return f_dg_type;
1091 
  return f_foreign;
1092 
}
1093 
 
1094 
sortname f_token
1095 
    PROTO_N ( (result, params) )
1096 
    PROTO_T ( sortname result X sortname_list params )
1097 
{
1098 
   sortname res;
1099 
   res.code = TOKEN;
1100 
   res.result = result.code;
1101 
   res.pars = params;
1102 
   return res;
1103 
}
1104 
 
1105 
sortname f_variety;
1106 
void init_sortname
1107 
    PROTO_Z ()
1108 
{
1109 
   f_alignment_sort.code = ALIGNMENT_SORT;
1110 
   f_bitfield_variety.code =   BITFIELD_VARIETY;
1111 
   f_bool.code =   BOOL;
1112 
   f_error_treatment.code =   ERROR_TREATMENT;
1113 
   f_exp.code =   EXP_S;
1114 
   f_floating_variety.code =   FLOATING_VARIETY;
1115 
   f_label.code = LABEL;
1116 
   f_nat.code =   NAT;
1117 
   f_ntest.code =   NTEST;
1118 
   f_rounding_mode.code =   ROUNDING_MODE;
1119 
   f_shape.code =   SHAPE;
1120 
   f_signed_nat.code =   SIGNED_NAT;
1121 
   f_tag.code = TAG;
1122 
   f_al_tag.code = AL_TAG;
1123 
   f_variety.code = VARIETY;
1124 
   f_diag_filename.code = DIAG_FILENAME;	/* OLD DIAGS */
1125 
   f_diag_type.code = DIAG_TYPE_SORT;		/* OLD DIAGS */
1126 
   f_foreign.code = FOREIGN;
1127 
   f_access.code = ACCESS_SORT;
1128 
   f_transfer_mode.code = TRANSFER_MODE_SORT;
1129 
   f_procprops.code = PROCPROPS;
1130 
   f_string.code = STRING;
1131 
   f_dg.code = DG_SORT;				/* NEW DIAGS */
1132 
   f_dg_dim.code = DG_DIM_SORT;			/* NEW DIAGS */
1133 
   f_dg_filename.code = DG_FILENAME_SORT;	/* NEW DIAGS */
1134 
   f_dg_idname.code = DG_IDNAME_SORT;		/* NEW DIAGS */
1135 
   f_dg_name.code = DG_NAME_SORT;		/* NEW DIAGS */
1136 
   f_dg_type.code = DG_TYPE_SORT;		/* NEW DIAGS */
1137 
 
1138 
   return;
1139 
}
1140 
 
1141 
sortname f_dummy_sortname;
1142 
 
1143 
tag f_tag_apply_token
1144 
    PROTO_N ( (token_value, token_args) )
1145 
    PROTO_T ( token token_value X bitstream token_args )
1146 
{
1147 
   tokval v;
1148 
   v = apply_tok(token_value, token_args, TAG, (tokval*)0);
1149 
   return v.tk_tag;
1150 
}
1151 
 
1152 
al_tag f_al_tag_apply_token
1153 
    PROTO_N ( (token_value, token_args) )
1154 
    PROTO_T ( token token_value X bitstream token_args )
1155 
{
1156 
   tokval v;
1157 
   v = apply_tok(token_value, token_args, AL_TAG, (tokval*)0);
1158 
   return v.tk_al_tag;
1159 
}
1160 
 
1161 
tag f_make_tag
1162 
    PROTO_N ( (tagno) )
1163 
    PROTO_T ( tdfint tagno )
1164 
{
1165 
  return get_dec(natint(tagno));
1166 
}
1167 
 
1168 
void init_tag
1169 
    PROTO_Z ()
1170 
{
1171 
  return;
1172 
}
1173 
 
1174 
al_tag f_make_al_tag
1175 
    PROTO_N ( (tagno) )
1176 
    PROTO_T ( tdfint tagno )
1177 
{
1178 
  return get_aldef(natint(tagno));
1179 
}
1180 
 
1181 
void init_al_tag
1182 
    PROTO_Z ()
1183 
{
1184 
  return;
1185 
}
1186 
 
1187 
tag f_dummy_tag;
1188 
al_tag f_dummy_al_tag;
1189 
 
1190 
void check_sig
1191 
    PROTO_N ( (tg, sig) )
1192 
    PROTO_T ( tag tg X string sig )
1193 
{
1194 
	char * sid = sig.ints.chars;
1195 
	int s = (sig.size*sig.number)/8;
1196 
	if (tg->dec_u.dec_val.has_signature) {
1197 
		char * id = tg->dec_u.dec_val.dec_id;
1198 
	    	int i;
1199 
		for(i=0; i<s; i++) {
1200 
			if (id[i]!=sid[i]) break;
1201 
		}
1202 
		if (i!=s || id[s] !=0) {
1203 
			   IGNORE fprintf(stderr, "%s\n%s\n", id, sid);
1204 
			   failer("Signatures should be equal");
1205 
		}
1206 
	}
1207 
	else {
1208 
		tg->dec_u.dec_val.dec_id = sid;
1209 
		tg->dec_u.dec_val.has_signature = 1;
1210 
	}
1211 
}
1212 
 
1213 
 
1214 
 
1215 
 
1216 
 
1217 
tagdec f_make_id_tagdec
1218 
    PROTO_N ( (t_intro, acc, sig, x) )
1219 
    PROTO_T ( tdfint t_intro X access_option acc X string_option sig X shape x )
1220 
{
1221 
  tagdec res;
1222 
  res.tg = get_dec(natint(t_intro));
1223 
  res.sha = x;
1224 
  res.acc = acc;
1225 
  res.is_variable = 0;
1226 
  res.is_common = 0;
1227 
  res.tg -> dec_u.dec_val.is_common = 0;
1228 
  if (sig.present) check_sig(res.tg, sig.val);
1229 
  return res;
1230 
}
1231 
 
1232 
tagdec f_make_var_tagdec
1233 
    PROTO_N ( (t_intro, acc, sig, x) )
1234 
    PROTO_T ( tdfint t_intro X access_option acc X string_option sig X shape x )
1235 
{
1236 
  tagdec res;
1237 
  res.tg = get_dec(natint(t_intro));
1238 
  res.sha = x;
1239 
  res.acc = acc;
1240 
  res.is_variable = 1;
1241 
  res.is_common = 0;
1242 
  res.tg -> dec_u.dec_val.is_common = 0;
1243 
  if (sig.present) check_sig(res.tg, sig.val);
1244 
  return res;
1245 
}
1246 
 
1247 
tagdec f_common_tagdec
1248 
    PROTO_N ( (t_intro, acc, sig, x) )
1249 
    PROTO_T ( tdfint t_intro X access_option acc X string_option sig X shape x )
1250 
{
1251 
  tagdec res;
1252 
  res.tg = get_dec(natint(t_intro));
1253 
  res.sha = x;
1254 
  res.acc = acc;
1255 
  res.is_variable = 1;
1256 
  res.is_common = 1;
1257 
  res.tg -> dec_u.dec_val.is_common = 0;
1258 
  if (sig.present) check_sig(res.tg, sig.val);
1259 
  return res;
1260 
}
1261 
 
1262 
void init_tagdec
1263 
    PROTO_Z ()
1264 
{
1265 
  return;
1266 
}
1267 
 
1268 
tagdec f_dummy_tagdec;
1269 
 
1270 
 
1271 
void start_make_id_tagdef
1272 
    PROTO_N ( (t) )
1273 
    PROTO_T ( tdfint t )
1274 
{
1275 
  UNUSED(t);
1276 
  rep_make_proc = 0;
1277 
  return;
1278 
}
1279 
 
1280 
tagdef f_make_id_tagdef
1281 
    PROTO_N ( (t, sig, e) )
1282 
    PROTO_T ( tdfint t X string_option sig X exp e )
1283 
{
1284 
  dec * dp = get_dec(natint(t));
1285 
  tagdef res;
1286 
  res.tg = dp;
1287 
  if (dp -> dec_u.dec_val.processed ||
1288 
        son(dp -> dec_u.dec_val.dec_exp) != nilexp)
1289 
    res.def = nilexp; /* set to nilexp if already output */
1290 
  else
1291 
    res.def = e;
1292 
  res.var = 0;
1293 
  res.is_common = 0;
1294 
  if (sig.present) check_sig(dp, sig.val);
1295 
  rep_make_proc = 1;
1296 
  return res;
1297 
}
1298 
 
1299 
void start_make_var_tagdef
1300 
    PROTO_N ( (t) )
1301 
    PROTO_T ( tdfint t )
1302 
{
1303 
  UNUSED(t);
1304 
 
1305 
  return;
1306 
}
1307 
 
1308 
tagdef f_make_var_tagdef
1309 
    PROTO_N ( (t, opt_access, sig, e) )
1310 
    PROTO_T ( tdfint t X access_option opt_access X string_option sig X exp e )
1311 
{
1312 
  dec * dp = get_dec(natint(t));
1313 
  tagdef res;
1314 
  UNUSED(opt_access);
1315 
  res.tg = dp;
1316 
  if (dp -> dec_u.dec_val.processed ||
1317 
        son(dp -> dec_u.dec_val.dec_exp) != nilexp)
1318 
    res.def = nilexp; /* set to nilexp if already output */
1319 
  else
1320 
    res.def = e;
1321 
  res.var = 1;
1322 
  res.is_common = 0;
1323 
  if (sig.present) check_sig(dp, sig.val);
1324 
  return res;
1325 
}
1326 
 
1327 
void start_common_tagdef
1328 
    PROTO_N ( (t) )
1329 
    PROTO_T ( tdfint t )
1330 
{
1331 
  UNUSED(t);
1332 
  return;
1333 
}
1334 
 
1335 
tagdef f_common_tagdef
1336 
    PROTO_N ( (t, opt_access, sig, e) )
1337 
    PROTO_T ( tdfint t X access_option opt_access X string_option sig X exp e )
1338 
{
1339 
  dec * dp = get_dec(natint(t));
1340 
  tagdef res;
1341 
  UNUSED(opt_access);
1342 
  res.tg = dp;
1343 
  res.def = e;
1344 
  res.var = 1;
1345 
  res.is_common = 1;
1346 
  if (sig.present) check_sig(dp, sig.val);
1347 
  return res;
1348 
}
1349 
 
1350 
void init_tagdef
1351 
    PROTO_Z ()
1352 
{
1353 
  return;
1354 
}
1355 
 
1356 
void init_al_tagdef
1357 
    PROTO_Z ()
1358 
{
1359 
  return;
1360 
}
1361 
 
1362 
tagdef f_dummy_tagdef;
1363 
al_tagdef f_dummy_al_tagdef;
1364 
 
1365 
char* add_prefix
1366 
    PROTO_N ( (nm) )
1367 
    PROTO_T ( char * nm )
1368 
{
1369 
  char * id;
1370 
  int idl = (int)strlen(nm);
1371 
  int   j;
1372 
  int npl = (int)strlen(name_prefix);
1373 
  if (npl == 0) return nm;
1374 
  id = (char *) xcalloc ( (idl + npl + 1), sizeof (char));
1375 
  id[idl + npl] = 0;
1376 
  for (j = npl; j < (idl+npl); ++j)
1377 
    id[j] = nm[j-npl];
1378 
  for (j = 0; j < npl; ++j)
1379 
    id[j] = name_prefix[j];
1380 
  return id;
1381 
}
1382 
 
1383 
tagextern f_make_tagextern
1384 
    PROTO_N ( (internal, ext) )
1385 
    PROTO_T ( tdfint internal X external ext )
1386 
{
1387 
  dec * dp = &capsule_tagtab[natint(internal)];
1388 
  char *nm = external_to_string(ext);
1389 
  char * id = add_prefix(nm);
1390 
  dp -> dec_u.dec_val.dec_id = id;
1391 
  dp -> dec_u.dec_val.dec_outermost = 1;
1392 
  dp -> dec_u.dec_val.extnamed = 1;
1393 
 
1394 
  return 0;
1395 
}
1396 
 
1397 
taglink f_make_taglink
1398 
    PROTO_N ( (internal, ext) )
1399 
    PROTO_T ( tdfint internal X tdfint ext )
1400 
{
1401 
  unit_ind_tags[natint(internal)] =
1402 
      &capsule_tagtab[natint(ext)];
1403 
  return 0;
1404 
}
1405 
 
1406 
 
1407 
allink f_make_allink
1408 
    PROTO_N ( (internal, ext) )
1409 
    PROTO_T ( tdfint internal X tdfint ext )
1410 
{
1411 
  unit_ind_als[natint(internal)] =
1412 
      &capsule_altab[natint(ext)];
1413 
  return 0;
1414 
}
1415 
 
1416 
 
1417 
tokdec f_make_tokdec
1418 
    PROTO_N ( (tok, sig, s) )
1419 
    PROTO_T ( tdfint tok X string_option sig X sortname s )
1420 
{
1421 
  tok_define * tok_d = get_tok(natint(tok));
1422 
  if (sig.present) check_tok_sig(tok_d, sig.val);
1423 
  UNUSED(s);
1424 
  return 0;
1425 
}
1426 
 
1427 
void init_tokdec
1428 
    PROTO_Z ()
1429 
{
1430 
  return;
1431 
}
1432 
 
1433 
tokdec f_dummy_tokdec;
1434 
 
1435 
tokdef f_make_tokdef
1436 
    PROTO_N ( (tokn, sig,def) )
1437 
    PROTO_T ( tdfint tokn X string_option sig X bitstream def )
1438 
{
1439 
  sortname result_sort;
1440 
  tokformals_list params;
1441 
  place old_place;
1442 
  tok_define * tok = get_tok(natint(tokn));
1443 
  if (sig.present) check_tok_sig(tok, sig.val);
1444 
  old_place = keep_place();
1445 
  set_place(def);
1446 
  IGNORE getcode(1);
1447 
  result_sort = d_sortname();
1448 
  params = d_tokformals_list();
1449 
  tok -> tdsort = result_sort;
1450 
  tok -> params = params;
1451 
  tok -> tdplace = keep_place();
1452 
  tok -> defined = 1;
1453 
  tok->tok_context = (context*)0;
1454 
 
1455 
    /* record the tables which are current so that they can be
1456 
       used when the token is applied */
1457 
  tok -> my_labtab = unit_labtab;
1458 
  tok -> my_tagtab = unit_ind_tags;
1459 
  tok -> my_toktab = unit_ind_tokens;
1460 
  tok -> my_altab = unit_ind_als;
1461 
  tok -> my_diagtab = unit_ind_diagtags;	/* OLD DIAGS */
1462 
  tok -> my_dgtab = unit_ind_dgtags;		/* NEW DIAGS */
1463 
  if (params.number == 0)
1464 
    tok -> re_evaluate = 0;
1465 
  else
1466 
    tok -> re_evaluate = 1;
1467 
 
1468 
  set_place(old_place);
1469 
  return 0;
1470 
}
1471 
 
1472 
token f_use_tokdef
1473 
    PROTO_N ( (def) )
1474 
    PROTO_T ( bitstream def )
1475 
{
1476 
  token tok = (token)xcalloc(1, sizeof(tok_define)) /* space thief ?*/;
1477 
  sortname result_sort;
1478 
  tokformals_list params;
1479 
  place old_place;
1480 
 
1481 
  old_place = keep_place();
1482 
  set_place(def);
1483 
  IGNORE getcode(1);
1484 
  result_sort = d_sortname();
1485 
  params = d_tokformals_list();
1486 
  tok -> tok_special = 0;
1487 
  tok -> valpresent = 0;
1488 
  tok -> unit_number = crt_tagdef_unit_no;
1489 
  tok -> defined = 0;
1490 
  tok -> is_capsule_token = 0;
1491 
  tok -> recursive = 0;
1492 
  tok -> tdsort = result_sort;
1493 
  tok -> params = params;
1494 
  tok -> tdplace = keep_place();
1495 
  tok -> defined = 1;
1496 
  tok->tok_context = crt_context;
1497 
 
1498 
    /* record the tables which are current so that they can be
1499 
       used when the token is applied */
1500 
  tok -> my_labtab = unit_labtab;
1501 
  tok -> my_tagtab = unit_ind_tags;
1502 
  tok -> my_toktab = unit_ind_tokens;
1503 
  tok -> my_altab = unit_ind_als;
1504 
  tok -> my_diagtab = unit_ind_diagtags;	/* OLD DIAGS */
1505 
  tok -> my_dgtab = unit_ind_dgtags;		/* NEW DIAGS */
1506 
 
1507 
  if (params.number == 0)
1508 
    tok -> re_evaluate = 0;
1509 
  else
1510 
    tok -> re_evaluate = 1;
1511 
 
1512 
  set_place(old_place);
1513 
  return tok;
1514 
}
1515 
 
1516 
 
1517 
void init_tokdef
1518 
    PROTO_Z ()
1519 
{
1520 
  return;
1521 
}
1522 
 
1523 
tokdef f_dummy_tokdef;
1524 
 
1525 
token f_token_apply_token
1526 
    PROTO_N ( (token_value, token_args) )
1527 
    PROTO_T ( token token_value X bitstream token_args )
1528 
{
1529 
   tokval v;
1530 
   v = apply_tok(token_value, token_args, TOKEN, (tokval*)0);
1531 
   return v.tk_token;
1532 
}
1533 
 
1534 
token f_make_tok
1535 
    PROTO_N ( (tokno) )
1536 
    PROTO_T ( tdfint tokno )
1537 
{
1538 
  return get_tok(natint(tokno));
1539 
}
1540 
 
1541 
void init_token
1542 
    PROTO_Z ()
1543 
{
1544 
  return;
1545 
}
1546 
 
1547 
token f_dummy_token;
1548 
 
1549 
token_defn f_token_definition
1550 
    PROTO_N ( (result_sort, tok_params) )
1551 
    PROTO_T ( sortname result_sort X tokformals_list tok_params )
1552 
{
1553 
  UNUSED (result_sort);
1554 
  UNUSED (tok_params);
1555 
  failer ("dummy");
1556 
  return f_dummy_token_defn;
1557 
}
1558 
 
1559 
void init_token_defn
1560 
    PROTO_Z ()
1561 
{
1562 
  return;
1563 
}
1564 
 
1565 
token_defn f_dummy_token_defn;
1566 
 
1567 
tokextern f_make_tokextern
1568 
    PROTO_N ( (internal, ext) )
1569 
    PROTO_T ( tdfint internal X external ext )
1570 
{
1571 
  tok_define * t = &capsule_toktab[natint(internal)];
1572 
  char * s = external_to_string(ext);
1573 
  t -> tok_name = s;
1574 
 
1575 
  if (machine_toks(s))  /* determines special tokens specific
1576 
			   to each machine */
1577 
    t -> tok_special = 1;
1578 
 
1579 
 
1580 
  if (replace_arith_type)  {
1581 
    if (!strcmp(s, "~arith_type"))
1582 
      t -> tok_special = 1;
1583 
    if (!strcmp(s, "~promote"))
1584 
      t -> tok_special = 1;
1585 
    if (!strcmp(s, "~sign_promote"))
1586 
      t -> tok_special = 1;
1587 
    if (!strcmp(s, "~convert"))
1588 
      t -> tok_special = 1;
1589 
  };
1590 
  if (do_alloca && !strcmp(s, "~alloca"))
1591 
    t -> tok_special = 1;
1592 
  return 0;
1593 
}
1594 
 
1595 
alextern f_make_alextern
1596 
    PROTO_N ( (internal, ext) )
1597 
    PROTO_T ( tdfint internal X external ext )
1598 
{
1599 
  UNUSED(internal); UNUSED(ext);
1600 
  return 0;
1601 
}
1602 
 
1603 
 
1604 
tokformals f_make_tokformals
1605 
    PROTO_N ( (sn, tk) )
1606 
    PROTO_T ( sortname sn X tdfint tk )
1607 
{
1608 
  tokformals res;
1609 
  res.sn = sn;
1610 
  res.tk = natint(tk);
1611 
  return res;
1612 
}
1613 
 
1614 
void init_tokformals
1615 
    PROTO_Z ()
1616 
{
1617 
  return;
1618 
}
1619 
 
1620 
toklink f_make_toklink
1621 
    PROTO_N ( (internal, ext) )
1622 
    PROTO_T ( tdfint internal X tdfint ext )
1623 
{
1624 
  unit_ind_tokens[natint(internal)] =
1625 
      &capsule_toktab[natint(ext)];
1626 
  return 0;
1627 
}
1628 
 
1629 
link f_make_link
1630 
    PROTO_N ( (internal, ext) )
1631 
    PROTO_T ( tdfint internal X tdfint ext )
1632 
{
1633 
  switch (crt_links_type)
1634 
   {
1635 
     case TOK_TYPE:
1636 
       IGNORE f_make_toklink(internal, ext);
1637 
       return 0;
1638 
     case TAG_TYPE:
1639 
       IGNORE f_make_taglink(internal, ext);
1640 
       return 0;
1641 
     case AL_TYPE:
1642 
       IGNORE f_make_allink(internal, ext);
1643 
       return 0;
1644 
     case DIAGTAG_TYPE:		/* OLD DIAGS */
1645 
       IGNORE f_make_diagtaglink(internal, ext);
1646 
       return 0;
1647 
     case DGTAG_TYPE:		/* NEW DIAGS */
1648 
       IGNORE f_make_dglink(internal, ext);
1649 
       return 0;
1650 
     default:
1651 
       failer(VARIABLE_TYPE);
1652 
       return 0;
1653 
   };
1654 
}
1655 
 
1656 
unique f_make_unique
1657 
    PROTO_N ( (text) )
1658 
    PROTO_T ( tdfstring_list text )
1659 
{
1660 
  return text;
1661 
}
1662 
 
1663 
void init_unique
1664 
    PROTO_Z ()
1665 
{
1666 
   return;
1667 
}
1668 
 
1669 
 
1670 
variety f_var_apply_token
1671 
    PROTO_N ( (token_value, token_args) )
1672 
    PROTO_T ( token token_value X bitstream token_args )
1673 
{
1674 
   tokval v;
1675 
   v = apply_tok(token_value, token_args, VARIETY, (tokval*)0);
1676 
   return v.tk_variety;
1677 
}
1678 
 
1679 
variety f_var_cond
1680 
    PROTO_N ( (control, e1, e2) )
1681 
    PROTO_T ( exp control X bitstream e1 X bitstream e2 )
1682 
{
1683 
  bitstream bs;
1684 
  variety res;
1685 
  int n;
1686 
  bs = keep_place();
1687 
  if (name(control) != val_tag)
1688 
    failer(CONTROL_EXP);
1689 
  n = no(control);
1690 
  retcell(control);
1691 
  if (n==0)
1692 
   {
1693 
     set_place(e2);
1694 
     res = d_variety();
1695 
   }
1696 
  else
1697 
   {
1698 
     set_place(e1);
1699 
     res = d_variety();
1700 
   };
1701 
 set_place(bs);
1702 
 return res;
1703 
}
1704 
 
1705 
 
1706 
void start_make_tokdec_unit
1707 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
1708 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
1709 
{
1710 
  int i;
1711 
 
1712 
  unit_no_of_tokens = no_of_tokens;
1713 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
1714 
                    sizeof(tok_define *));
1715 
  for (i = 0; i < unit_no_of_tokens; ++i)
1716 
    unit_ind_tokens[i] = (tok_define*)0;
1717 
 
1718 
  unit_no_of_tags = no_of_tags;
1719 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
1720 
                    sizeof(dec *));
1721 
  for (i = 0; i < unit_no_of_tags; ++i)
1722 
    unit_ind_tags[i] = (dec*)0;
1723 
 
1724 
  unit_no_of_als = no_of_als;
1725 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
1726 
                    sizeof(aldef *));
1727 
  for (i = 0; i < unit_no_of_als; ++i)
1728 
    unit_ind_als[i] = (aldef*)0;
1729 
 
1730 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
1731 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
1732 
                    sizeof(diag_tagdef *));
1733 
  for (i = 0; i < unit_no_of_diagtags; ++i)
1734 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
1735 
 
1736 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
1737 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
1738 
                    sizeof(dgtag_struct *));
1739 
  for (i = 0; i < unit_no_of_dgtags; ++i)
1740 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
1741 
 
1742 
  return;
1743 
}
1744 
 
1745 
tokdec_unit f_make_tokdec_unit
1746 
    PROTO_Z ()
1747 
{
1748 
  int i;
1749 
  int j = 0;
1750 
  for (i = 0; i < unit_no_of_tokens; ++i)
1751 
   {
1752 
    if (unit_ind_tokens[i] == (tok_define*)0)
1753 
      unit_ind_tokens[i] = &unit_toktab[j++];
1754 
   };
1755 
  start_bytestream();
1756 
  IGNORE d_tokdec_list();
1757 
  end_bytestream();
1758 
  return 0;
1759 
}
1760 
 
1761 
void start_make_tokdef_unit
1762 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
1763 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
1764 
{
1765 
  int i;
1766 
 
1767 
  unit_no_of_tokens = no_of_tokens;
1768 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
1769 
                    sizeof(tok_define *));
1770 
  for (i = 0; i < unit_no_of_tokens; ++i)
1771 
    unit_ind_tokens[i] = (tok_define*)0;
1772 
 
1773 
  unit_no_of_tags = no_of_tags;
1774 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
1775 
                    sizeof(dec *));
1776 
  for (i = 0; i < unit_no_of_tags; ++i)
1777 
    unit_ind_tags[i] = (dec*)0;
1778 
 
1779 
  unit_no_of_als = no_of_als;
1780 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
1781 
                    sizeof(aldef *));
1782 
  for (i = 0; i < unit_no_of_als; ++i)
1783 
    unit_ind_als[i] = (aldef*)0;
1784 
 
1785 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
1786 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
1787 
                    sizeof(diag_tagdef *));
1788 
  for (i = 0; i < unit_no_of_diagtags; ++i)
1789 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
1790 
 
1791 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
1792 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
1793 
                    sizeof(dgtag_struct *));
1794 
  for (i = 0; i < unit_no_of_dgtags; ++i)
1795 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
1796 
 
1797 
  return;
1798 
}
1799 
 
1800 
tokdef_unit f_make_tokdef_unit
1801 
    PROTO_Z ()
1802 
{
1803 
  int i;
1804 
  int j = 0;
1805 
  int no_of_labels;
1806 
  for (i = 0; i < unit_no_of_tokens; ++i)
1807 
   {
1808 
    if (unit_ind_tokens[i] == (tok_define*)0)
1809 
      unit_ind_tokens[i] = &unit_toktab[j++];
1810 
   };
1811 
  j = 0;
1812 
  for (i = 0; i < unit_no_of_tags; ++i)
1813 
   {
1814 
    if (unit_ind_tags[i] == (dec*)0)
1815 
      unit_ind_tags[i] = &unit_tagtab[j++];
1816 
   };
1817 
  j = 0;
1818 
  for (i = 0; i < unit_no_of_als; ++i)
1819 
   {
1820 
    if (unit_ind_als[i] == (aldef*)0)
1821 
      unit_ind_als[i] = &unit_altab[j++];
1822 
   };
1823 
  j = 0;
1824 
  for (i = 0; i < unit_no_of_dgtags; ++i)	/* NEW DIAGS */
1825 
   {
1826 
    if (unit_ind_dgtags[i] == (dgtag_struct *)0)
1827 
      unit_ind_dgtags[i] = &unit_dgtagtab[j++];
1828 
   };
1829 
  start_bytestream();
1830 
  no_of_labels = small_dtdfint();
1831 
  unit_no_of_labels = no_of_labels;
1832 
  unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
1833 
  IGNORE d_tokdef_list();
1834 
  end_bytestream();
1835 
 
1836 
  /* tables must be kept for use during token application */
1837 
 
1838 
  return 0;
1839 
}
1840 
 
1841 
void start_make_tagdec_unit
1842 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
1843 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
1844 
{
1845 
  int i;
1846 
 
1847 
  unit_no_of_tokens = no_of_tokens;
1848 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
1849 
                    sizeof(tok_define *));
1850 
  for (i = 0; i < unit_no_of_tokens; ++i)
1851 
    unit_ind_tokens[i] = (tok_define*)0;
1852 
 
1853 
  unit_no_of_tags = no_of_tags;
1854 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
1855 
                    sizeof(dec *));
1856 
  for (i = 0; i < unit_no_of_tags; ++i)
1857 
    unit_ind_tags[i] = (dec*)0;
1858 
 
1859 
  unit_no_of_als = no_of_als;
1860 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
1861 
                    sizeof(aldef *));
1862 
  for (i = 0; i < unit_no_of_als; ++i)
1863 
    unit_ind_als[i] = (aldef*)0;
1864 
 
1865 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
1866 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
1867 
                    sizeof(diag_tagdef *));
1868 
  for (i = 0; i < unit_no_of_diagtags; ++i)
1869 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
1870 
 
1871 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
1872 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
1873 
                    sizeof(dgtag_struct *));
1874 
  for (i = 0; i < unit_no_of_dgtags; ++i)
1875 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
1876 
 
1877 
  return;
1878 
}
1879 
 
1880 
tagdec_unit f_make_tagdec_unit
1881 
    PROTO_Z ()
1882 
{
1883 
  int i;
1884 
  int j = 0;
1885 
  int no_of_labels;
1886 
  for (i = 0; i < unit_no_of_tokens; ++i)
1887 
   {
1888 
    if (unit_ind_tokens[i] == (tok_define*)0)
1889 
      unit_ind_tokens[i] = &unit_toktab[j++];
1890 
   };
1891 
  j = 0;
1892 
  for (i = 0; i < unit_no_of_tags; ++i)
1893 
   {
1894 
    if (unit_ind_tags[i] == (dec*)0)
1895 
      unit_ind_tags[i] = &unit_tagtab[j++];
1896 
   };
1897 
  j = 0;
1898 
  for (i = 0; i < unit_no_of_als; ++i)
1899 
   {
1900 
    if (unit_ind_als[i] == (aldef*)0)
1901 
      unit_ind_als[i] = &unit_altab[j++];
1902 
   };
1903 
  j = 0;
1904 
  for (i = 0; i < unit_no_of_dgtags; ++i)	/* NEW DIAGS */
1905 
   {
1906 
    if (unit_ind_dgtags[i] == (dgtag_struct *)0)
1907 
      unit_ind_dgtags[i] = &unit_dgtagtab[j++];
1908 
   };
1909 
  start_bytestream();
1910 
  no_of_labels = small_dtdfint();
1911 
  unit_no_of_labels = no_of_labels;
1912 
  unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
1913 
  IGNORE d_tagdec_list();
1914 
  end_bytestream();
1915 
 
1916 
  xfree((void*)unit_ind_tokens);
1917 
  xfree((void*)unit_ind_tags);
1918 
  xfree((void*)unit_ind_als);
1919 
  xfree((void*)unit_labtab);
1920 
 
1921 
  xfree((void*)unit_toktab);
1922 
 
1923 
  return 0;
1924 
}
1925 
 
1926 
void start_make_versions_unit
1927 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
1928 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
1929 
{
1930 
  int i;
1931 
 
1932 
  unit_no_of_tokens = no_of_tokens;
1933 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
1934 
                    sizeof(tok_define *));
1935 
  for (i = 0; i < unit_no_of_tokens; ++i)
1936 
    unit_ind_tokens[i] = (tok_define*)0;
1937 
 
1938 
  unit_no_of_tags = no_of_tags;
1939 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
1940 
                    sizeof(dec *));
1941 
  for (i = 0; i < unit_no_of_tags; ++i)
1942 
    unit_ind_tags[i] = (dec*)0;
1943 
 
1944 
  unit_no_of_als = no_of_als;
1945 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
1946 
                    sizeof(aldef *));
1947 
  for (i = 0; i < unit_no_of_als; ++i)
1948 
    unit_ind_als[i] = (aldef*)0;
1949 
 
1950 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
1951 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
1952 
                    sizeof(diag_tagdef *));
1953 
  for (i = 0; i < unit_no_of_diagtags; ++i)
1954 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
1955 
 
1956 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
1957 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
1958 
                    sizeof(dgtag_struct *));
1959 
  for (i = 0; i < unit_no_of_dgtags; ++i)
1960 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
1961 
 
1962 
  return;
1963 
}
1964 
 
1965 
version_props f_make_versions_unit
1966 
    PROTO_Z ()
1967 
{
1968 
  int i;
1969 
  int j = 0;
1970 
  for (i = 0; i < unit_no_of_tokens; ++i)
1971 
   {
1972 
    if (unit_ind_tokens[i] == (tok_define*)0)
1973 
      unit_ind_tokens[i] = &unit_toktab[j++];
1974 
   };
1975 
  j = 0;
1976 
  for (i = 0; i < unit_no_of_tags; ++i)
1977 
   {
1978 
    if (unit_ind_tags[i] == (dec*)0)
1979 
      unit_ind_tags[i] = &unit_tagtab[j++];
1980 
   };
1981 
  j = 0;
1982 
  for (i = 0; i < unit_no_of_als; ++i)
1983 
   {
1984 
    if (unit_ind_als[i] == (aldef*)0)
1985 
      unit_ind_als[i] = &unit_altab[j++];
1986 
   };
1987 
  start_bytestream();
1988 
  IGNORE d_version_list();
1989 
  end_bytestream();
1990 
 
1991 
  xfree((void*)unit_ind_tokens);
1992 
  xfree((void*)unit_ind_tags);
1993 
  xfree((void*)unit_ind_als);
1994 
 
1995 
  xfree((void*)unit_toktab);
1996 
  xfree((void*)unit_tagtab);
1997 
 
1998 
  return 0;
1999 
}
2000 
 
2001 
void start_make_tagdef_unit
2002 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
2003 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
2004 
{
2005 
  int i;
2006 
 
2007 
  if (separate_units)
2008 
   {
2009 
    ++crt_tagdef_unit_no;
2010 
    set_large_alloc();
2011 
   };
2012 
 
2013 
  unit_no_of_tokens = no_of_tokens;
2014 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
2015 
                    sizeof(tok_define *));
2016 
  for (i = 0; i < unit_no_of_tokens; ++i)
2017 
    unit_ind_tokens[i] = (tok_define*)0;
2018 
 
2019 
  unit_no_of_tags = no_of_tags;
2020 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
2021 
                    sizeof(dec *));
2022 
  for (i = 0; i < unit_no_of_tags; ++i)
2023 
    unit_ind_tags[i] = (dec*)0;
2024 
 
2025 
  unit_no_of_als = no_of_als;
2026 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
2027 
                    sizeof(aldef *));
2028 
  for (i = 0; i < unit_no_of_als; ++i)
2029 
    unit_ind_als[i] = (aldef*)0;
2030 
 
2031 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
2032 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
2033 
                    sizeof(diag_tagdef *));
2034 
  for (i = 0; i < unit_no_of_diagtags; ++i)
2035 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
2036 
 
2037 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
2038 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
2039 
                    sizeof(dgtag_struct *));
2040 
  for (i = 0; i < unit_no_of_dgtags; ++i)
2041 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
2042 
 
2043 
  return;
2044 
}
2045 
 
2046 
 
2047 
 
2048 
 
2049 
tagdef_unit f_make_tagdef_unit
2050 
    PROTO_Z ()
2051 
{
2052 
  int i;
2053 
  int j = 0;
2054 
  int no_of_labels;
2055 
  for (i = 0; i < unit_no_of_tokens; ++i)
2056 
   {
2057 
    if (unit_ind_tokens[i] == (tok_define*)0)
2058 
      unit_ind_tokens[i] = &unit_toktab[j++];
2059 
   };
2060 
  j = 0;
2061 
  for (i = 0; i < unit_no_of_tags; ++i)
2062 
   {
2063 
    if (unit_ind_tags[i] == (dec*)0)
2064 
      unit_ind_tags[i] = &unit_tagtab[j++];
2065 
   };
2066 
  j = 0;
2067 
  for (i = 0; i < unit_no_of_als; ++i)
2068 
   {
2069 
    if (unit_ind_als[i] == (aldef*)0)
2070 
      unit_ind_als[i] = &unit_altab[j++];
2071 
   };
2072 
  j = 0;
2073 
  for (i = 0; i < unit_no_of_dgtags; ++i)	/* NEW DIAGS */
2074 
   {
2075 
    if (unit_ind_dgtags[i] == (dgtag_struct *)0)
2076 
      unit_ind_dgtags[i] = &unit_dgtagtab[j++];
2077 
   };
2078 
  start_bytestream();
2079 
  no_of_labels = small_dtdfint();
2080 
  unit_no_of_labels = no_of_labels;
2081 
  unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
2082 
  IGNORE d_tagdef_list();
2083 
  tidy_initial_values();
2084 
  translate_unit();
2085 
  end_bytestream();
2086 
 
2087 
  xfree((void*)unit_ind_tokens);
2088 
  xfree((void*)unit_ind_tags);
2089 
  xfree((void*)unit_ind_als);
2090 
  xfree((void*)unit_labtab);
2091 
 
2092 
  xfree((void*)unit_toktab);
2093 
  xfree((void*)unit_tagtab);
2094 
 
2095 
  return 0;
2096 
}
2097 
 
2098 
void start_make_aldef_unit
2099 
    PROTO_N ( (no_of_tokens, no_of_tags, no_of_als, no_of_diagtags, no_of_dgtags) )
2100 
    PROTO_T ( int no_of_tokens X int no_of_tags X int no_of_als X int no_of_diagtags X int no_of_dgtags )
2101 
{
2102 
  int i;
2103 
 
2104 
  unit_no_of_tokens = no_of_tokens;
2105 
  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
2106 
                    sizeof(tok_define *));
2107 
  for (i = 0; i < unit_no_of_tokens; ++i)
2108 
    unit_ind_tokens[i] = (tok_define*)0;
2109 
 
2110 
  unit_no_of_tags = no_of_tags;
2111 
  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
2112 
                    sizeof(dec *));
2113 
  for (i = 0; i < unit_no_of_tags; ++i)
2114 
    unit_ind_tags[i] = (dec*)0;
2115 
 
2116 
  unit_no_of_als = no_of_als;
2117 
  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
2118 
                    sizeof(aldef *));
2119 
  for (i = 0; i < unit_no_of_als; ++i)
2120 
    unit_ind_als[i] = (aldef*)0;
2121 
 
2122 
  unit_no_of_diagtags = no_of_diagtags;		/* OLD DIAGS */
2123 
  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
2124 
                    sizeof(diag_tagdef *));
2125 
  for (i = 0; i < unit_no_of_diagtags; ++i)
2126 
    unit_ind_diagtags[i] = (diag_tagdef *)0;
2127 
 
2128 
  unit_no_of_dgtags = no_of_dgtags;		/* NEW DIAGS */
2129 
  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
2130 
                    sizeof(dgtag_struct *));
2131 
  for (i = 0; i < unit_no_of_dgtags; ++i)
2132 
    unit_ind_dgtags[i] = (dgtag_struct *)0;
2133 
 
2134 
  return;
2135 
}
2136 
 
2137 
aldef_unit f_make_aldef_unit
2138 
    PROTO_Z ()
2139 
{
2140 
  int i;
2141 
  int j = 0;
2142 
  int no_of_labels;
2143 
  for (i = 0; i < unit_no_of_tokens; ++i)
2144 
   {
2145 
    if (unit_ind_tokens[i] == (tok_define*)0)
2146 
      unit_ind_tokens[i] = &unit_toktab[j++];
2147 
   };
2148 
  j = 0;
2149 
  for (i = 0; i < unit_no_of_als; ++i)
2150 
   {
2151 
    if (unit_ind_als[i] == (aldef*)0)
2152 
      unit_ind_als[i] = &unit_altab[j++];
2153 
   };
2154 
  start_bytestream();
2155 
  no_of_labels = small_dtdfint();
2156 
  unit_no_of_labels = no_of_labels;
2157 
  unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
2158 
  IGNORE d_al_tagdef_list();
2159 
  end_bytestream();
2160 
 
2161 
  xfree((void*)unit_ind_tokens);
2162 
  xfree((void*)unit_ind_tags);
2163 
  xfree((void*)unit_ind_als);
2164 
  xfree((void*)unit_labtab);
2165 
 
2166 
  xfree((void*)unit_toktab);
2167 
  xfree((void*)unit_tagtab);
2168 
 
2169 
  return 0;
2170 
}
2171 
 
2172 
void start_make_unit
2173 
    PROTO_N ( (lvl) )
2174 
    PROTO_T ( tdfint_list lvl )
2175 
{
2176 
  int w;
2177 
  int ntok = 0;
2178 
  int ntag = 0;
2179 
  int nal = 0;
2180 
  int ndiagtype = 0;	/* OLD DIAGS */
2181 
  int ndgtag = 0;	/* NEW DIAGS */
2182 
 
2183 
  ++unit_index;
2184 
 
2185 
  if (lvl.number != 0) {
2186 
    w = find_index("token");
2187 
    ntok = (w == -1) ? 0 : natint(lvl.members[w]);
2188 
    w = find_index("tag");
2189 
    ntag = (w == -1) ? 0 : natint(lvl.members[w]);
2190 
    w = find_index("alignment");
2191 
    nal = (w == -1) ? 0 : natint(lvl.members[w]);
2192 
    w = find_index("diagtag");		/* OLD DIAGS */
2193 
    ndiagtype = (w == -1) ? 0 : natint(lvl.members[w]);
2194 
    w = find_index("dgtag");		/* NEW DIAGS */
2195 
    ndgtag = (w == -1) ? 0 : natint(lvl.members[w]);
2196 
  };
2197 
 
2198 
  switch(crt_group_type)
2199 
   {
2200 
     case TOKDEC_UNIT:
2201 
              start_make_tokdec_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2202 
              return;
2203 
     case TOKDEF_UNIT:
2204 
              start_make_tokdef_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2205 
              return;
2206 
     case AL_UNIT:
2207 
	      doing_aldefs = 1;
2208 
              start_make_aldef_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2209 
              return;
2210 
     case TAGDEC_UNIT:
2211 
	      if (doing_aldefs) {
2212 
                process_aldefs();
2213 
	        doing_aldefs = 0;
2214 
	      };
2215 
              start_make_tagdec_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2216 
              return;
2217 
     case TAGDEF_UNIT:
2218 
              start_make_tagdef_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2219 
              return;
2220 
     case DIAGDEF_UNIT:		/* OLD DIAGS */
2221 
              start_make_diagdef_unit(ntok, ntag, nal, ndiagtype);
2222 
              return;
2223 
     case DIAGTYPE_UNIT:	/* OLD DIAGS */
2224 
	      if (doing_aldefs) {
2225 
                process_aldefs();
2226 
	        doing_aldefs = 0;
2227 
	      };
2228 
              start_make_diagtype_unit(ntok, ntag, nal, ndiagtype);
2229 
              return;
2230 
     case LINKINFO_UNIT:
2231 
              start_make_linkinfo_unit(ntok, ntag, nal, 0 /* discarded */);
2232 
              return;
2233 
     case VERSIONS_UNIT:
2234 
              start_make_versions_unit(ntok, ntag, nal, ndiagtype, ndgtag);
2235 
              return;
2236 
     case DGCOMP_UNIT:	/* NEW DIAGS */
2237 
	      if (doing_aldefs) {
2238 
                process_aldefs();
2239 
	        doing_aldefs = 0;
2240 
	      };
2241 
              start_make_dg_comp_unit(ntok, ntag, nal, ndgtag);
2242 
              return;
2243 
     default:
2244 
              return;
2245 
   };
2246 
}
2247 
 
2248 
unit f_make_unit
2249 
    PROTO_N ( (lvl, lks, prs) )
2250 
    PROTO_T ( tdfint_list lvl X links_list lks X bytestream prs )
2251 
{
2252 
  UNUSED(lvl); UNUSED(lks); UNUSED(prs);
2253 
  switch(crt_group_type)
2254 
   {
2255 
     case TOKDEC_UNIT:
2256 
              IGNORE f_make_tokdec_unit();
2257 
              break;
2258 
     case TOKDEF_UNIT:
2259 
              IGNORE f_make_tokdef_unit();
2260 
              break;
2261 
     case AL_UNIT:
2262 
              IGNORE f_make_aldef_unit();
2263 
              break;
2264 
     case TAGDEC_UNIT:
2265 
              IGNORE f_make_tagdec_unit();
2266 
              break;
2267 
     case TAGDEF_UNIT:
2268 
              IGNORE f_make_tagdef_unit();
2269 
              break;
2270 
     case DIAGDEF_UNIT:		/* OLD DIAGS */
2271 
              if (diagnose)
2272 
                IGNORE f_make_diagdef_unit();
2273 
              else
2274 
                ignore_bytestream();
2275 
              break;
2276 
     case DIAGTYPE_UNIT:	/* OLD DIAGS */
2277 
              if (diagnose)
2278 
                IGNORE f_make_diagtype_unit();
2279 
              else
2280 
                ignore_bytestream();
2281 
              break;
2282 
     case LINKINFO_UNIT:
2283 
              IGNORE f_make_linkinfo_unit();
2284 
              break;
2285 
     case VERSIONS_UNIT:
2286 
	      IGNORE f_make_versions_unit();
2287 
	      break;
2288 
     case DGCOMP_UNIT:	/* NEW DIAGS */
2289 
              if (diagnose)
2290 
                IGNORE f_make_dg_comp_unit();
2291 
              else
2292 
                ignore_bytestream();
2293 
              break;
2294 
     default:
2295 
              ignore_bytestream();
2296 
              break;
2297 
   };
2298 
  return 0;
2299 
}
2300 
 
2301 
linkextern f_make_linkextern
2302 
    PROTO_N ( (internal, ext) )
2303 
    PROTO_T ( tdfint internal X external ext )
2304 
{
2305 
  switch (crt_extern_link_type)
2306 
   {
2307 
     case TOK_TYPE:
2308 
       return f_make_tokextern(internal, ext);
2309 
     case TAG_TYPE:
2310 
       return f_make_tagextern(internal, ext);
2311 
     case AL_TYPE:
2312 
       return f_make_alextern(internal, ext);
2313 
     case DIAGTAG_TYPE:		/* OLD DIAGS */
2314 
       return f_make_diagtagextern(internal, ext);
2315 
     case DGTAG_TYPE:		/* NEW DIAGS */
2316 
       return f_make_dgtagextern(internal, ext);
2317 
     default:
2318 
       failer(VARIABLE_TYPE);
2319 
       return 0;
2320 
   };
2321 
}
2322 
 
2323 
group f_make_group
2324 
    PROTO_N ( (us) )
2325 
    PROTO_T ( unit_list us )
2326 
{
2327 
  UNUSED(us);
2328 
  return 0;
2329 
}
2330 
 
2331 
links f_make_links
2332 
    PROTO_N ( (ls) )
2333 
    PROTO_T ( link_list ls )
2334 
{
2335 
  UNUSED(ls);
2336 
  return 0;
2337 
}
2338 
 
2339 
extern_link f_make_extern_link
2340 
    PROTO_N ( (el) )
2341 
    PROTO_T ( linkextern_list el )
2342 
{
2343 
  UNUSED(el);
2344 
  return 0;
2345 
}
2346 
 
2347 
tokdef_props f_make_tokdefs
2348 
    PROTO_N ( (nl, tds) )
2349 
    PROTO_T ( tdfint nl X tokdef_list tds )
2350 
{
2351 
  UNUSED(nl); UNUSED(tds);
2352 
  return 0;
2353 
}
2354 
 
2355 
tokdec_props f_make_tokdecs
2356 
    PROTO_N ( (tds) )
2357 
    PROTO_T ( tokdec_list tds )
2358 
{
2359 
  UNUSED(tds);
2360 
  return 0;
2361 
}
2362 
 
2363 
tagdef_props f_make_tagdefs
2364 
    PROTO_N ( (nl, tds) )
2365 
    PROTO_T ( tdfint nl X tagdef_list tds )
2366 
{
2367 
  UNUSED(nl); UNUSED(tds);
2368 
  return 0;
2369 
}
2370 
 
2371 
al_tagdef_props f_make_al_tagdefs
2372 
    PROTO_N ( (nl, tds) )
2373 
    PROTO_T ( tdfint nl X al_tagdef_list tds )
2374 
{
2375 
  UNUSED(nl); UNUSED(tds);
2376 
  return 0;
2377 
}
2378 
 
2379 
tagdec_props f_make_tagdecs
2380 
    PROTO_N ( (nl, tds) )
2381 
    PROTO_T ( tdfint nl X tagdec_list tds )
2382 
{
2383 
 UNUSED(nl); UNUSED(tds);
2384 
 return 0;
2385 
}
2386 
 
2387 
 
2388 
 
2389 
sortname_list new_sortname_list
2390 
    PROTO_N ( (n) )
2391 
    PROTO_T ( int n )
2392 
{
2393 
  sortname_list res;
2394 
  res.number = n;
2395 
  res.elems = (sortname*)xcalloc(n, sizeof(sortname));
2396 
  return res;
2397 
}
2398 
 
2399 
sortname_list add_sortname_list
2400 
    PROTO_N ( (list, elem, index) )
2401 
    PROTO_T ( sortname_list list X sortname elem X int index )
2402 
{
2403 
  list.elems[index] = elem;
2404 
  return list;
2405 
}
2406 
 
2407 
tokformals_list new_tokformals_list
2408 
    PROTO_N ( (n) )
2409 
    PROTO_T ( int n )
2410 
{
2411 
  tokformals_list res;
2412 
  res.number = n;
2413 
  res.par_sorts = (sortname *)xcalloc(n, sizeof(sortname));
2414 
  res.par_names = (int *)xcalloc(n, sizeof(int));
2415 
  return res;
2416 
}
2417 
 
2418 
tokformals_list add_tokformals_list
2419 
    PROTO_N ( (list, elem, index) )
2420 
    PROTO_T ( tokformals_list list X tokformals elem X int index )
2421 
{
2422 
  list.par_sorts[index] = elem.sn;
2423 
  list.par_names[index] = elem.tk;
2424 
  return list;
2425 
}
2426 
 
2427 
tokdec_list new_tokdec_list
2428 
    PROTO_N ( (n) )
2429 
    PROTO_T ( int n )
2430 
{
2431 
  UNUSED(n);
2432 
  return 0;
2433 
}
2434 
 
2435 
tokdec_list add_tokdec_list
2436 
    PROTO_N ( (list, elem, index) )
2437 
    PROTO_T ( tokdec_list list X tokdec elem X int index )
2438 
{
2439 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2440 
  return 0;
2441 
}
2442 
 
2443 
tokdef_list new_tokdef_list
2444 
    PROTO_N ( (n) )
2445 
    PROTO_T ( int n )
2446 
{
2447 
  UNUSED(n);
2448 
  return 0;
2449 
}
2450 
 
2451 
tokdef_list add_tokdef_list
2452 
    PROTO_N ( (list, elem, index) )
2453 
    PROTO_T ( tokdef_list list X tokdef elem X int index )
2454 
{
2455 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2456 
  return 0;
2457 
}
2458 
 
2459 
al_tagdef_list new_al_tagdef_list
2460 
    PROTO_N ( (n) )
2461 
    PROTO_T ( int n )
2462 
{
2463 
  UNUSED(n);
2464 
  return 0;
2465 
}
2466 
 
2467 
al_tagdef_list add_al_tagdef_list
2468 
    PROTO_N ( (list, elem, index) )
2469 
    PROTO_T ( al_tagdef_list list X al_tagdef elem X int index )
2470 
{
2471 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2472 
  return 0;
2473 
}
2474 
 
2475 
 
2476 
al_tagdef f_make_al_tagdef
2477 
    PROTO_N ( (t, a) )
2478 
    PROTO_T ( tdfint t X alignment a )
2479 
{
2480 
  aldef * ap = get_aldef(natint(t));
2481 
  ap -> next_aldef = top_aldef;
2482 
  top_aldef = ap;
2483 
  ap -> al = a -> al;
2484 
  return 0;
2485 
}
2486 
 
2487 
 
2488 
 
2489 
tagdec_list new_tagdec_list
2490 
    PROTO_N ( (n) )
2491 
    PROTO_T ( int n )
2492 
{
2493 
  UNUSED(n);
2494 
  return 0;
2495 
}
2496 
 
2497 
tagdec_list add_tagdec_list
2498 
    PROTO_N ( (list, elem, index) )
2499 
    PROTO_T ( tagdec_list list X tagdec elem X int index )
2500 
{
2501 
    dec * dp = elem.tg;
2502 
    shape s;
2503 
    exp e;
2504 
    UNUSED(list); UNUSED(index);
2505 
    s = elem.sha;
2506 
 
2507 
    e = getexp(s, nilexp, 0, nilexp, nilexp, 0, 0, ident_tag);
2508 
 
2509 
    if (elem.is_variable)
2510 
     {
2511 
#if keep_PIC_vars
2512 
       setvar(e);
2513 
#else
2514 
       if (PIC_code && dp -> dec_u.dec_val.extnamed)
2515 
         sh(e) = f_pointer(f_alignment(s));
2516 
       else
2517 
         setvar(e);
2518 
#endif
2519 
     };
2520 
 
2521 
    if (elem.acc & (f_visible | f_long_jump_access))
2522 
      setvis(e);
2523 
    if (elem.acc & f_constant)
2524 
      setcaonly(e);
2525 
 
2526 
    dp -> dec_u.dec_val.acc = elem.acc;
2527 
 
2528 
    dp -> dec_u.dec_val.dec_exp = e;
2529 
 
2530 
    if (dp -> dec_u.dec_val.dec_shape != nilexp) {
2531 
      if (shape_size(s) > shape_size(dp -> dec_u.dec_val.dec_shape))
2532 
        dp -> dec_u.dec_val.dec_shape = s;
2533 
    };
2534 
 
2535 
    if (dp -> dec_u.dec_val.dec_shape == nilexp) {
2536 
      dp -> dec_u.dec_val.dec_shape = s;
2537 
      dp -> def_next = (dec *)0;
2538 
      *deflist_end = dp;
2539 
      deflist_end = &((*deflist_end) -> def_next);
2540 
    };
2541 
 
2542 
    dp -> dec_u.dec_val.dec_var = (unsigned int)(isvar(e) || elem.is_variable) ;
2543 
    if (!dp -> dec_u.dec_val.have_def)
2544 
     {
2545 
      setglob(e);
2546 
     };
2547 
    /* the defining exp */
2548 
    brog(dp -> dec_u.dec_val.dec_exp) = dp;
2549 
    if (dp -> dec_u.dec_val.dec_id == (char *) 0)
2550 
      dp -> dec_u.dec_val.dec_id = make_local_name();
2551 
 
2552 
  return 0;
2553 
}
2554 
 
2555 
tagdef_list new_tagdef_list
2556 
    PROTO_N ( (n) )
2557 
    PROTO_T ( int n )
2558 
{
2559 
  UNUSED(n);
2560 
  return 0;
2561 
}
2562 
 
2563 
tagdef_list add_tagdef_list
2564 
    PROTO_N ( (list, elem, index) )
2565 
    PROTO_T ( tagdef_list list X tagdef elem X int index )
2566 
{
2567 
  dec * dp = elem.tg;
2568 
  exp old_def = son(dp -> dec_u.dec_val.dec_exp);
2569 
  exp new_def = elem.def;
2570 
  UNUSED(list); UNUSED(index);
2571 
  if (dp -> dec_u.dec_val.processed || new_def == nilexp)
2572 
    return 0;
2573 
 
2574 
  if (old_def == nilexp ||
2575 
       shape_size(sh(new_def)) > shape_size(sh(old_def)) ||
2576 
       (name(new_def) != clear_tag && name(old_def) == clear_tag))  {
2577 
    son(dp -> dec_u.dec_val.dec_exp) = new_def;
2578 
    setfather(dp -> dec_u.dec_val.dec_exp, elem.def);
2579 
  };
2580 
 
2581 
  return 0;
2582 
}
2583 
 
2584 
tdfident_list new_tdfident_list
2585 
    PROTO_N ( (n) )
2586 
    PROTO_T ( int n )
2587 
{
2588 
  tdfstring_list res;
2589 
  res.elems = (tdfstring *)xcalloc(n, sizeof(tdfstring));
2590 
  res.number = n;
2591 
  return res;
2592 
}
2593 
 
2594 
tdfident_list add_tdfident_list
2595 
    PROTO_N ( (list, elem, index) )
2596 
    PROTO_T ( tdfident_list list X tdfident elem X int index )
2597 
{
2598 
  list.elems[index] = elem;
2599 
  return list;
2600 
}
2601 
 
2602 
tdfint_list new_tdfint_list
2603 
    PROTO_N ( (n) )
2604 
    PROTO_T ( int n )
2605 
{
2606 
  tdfint_list res;
2607 
  res.members = (tdfint *)xcalloc(n, sizeof(tdfint));
2608 
  res.number = n;
2609 
  return res;
2610 
}
2611 
 
2612 
tdfint_list add_tdfint_list
2613 
    PROTO_N ( (list, elem, index) )
2614 
    PROTO_T ( tdfint_list list X tdfint elem X int index )
2615 
{
2616 
  list.members[index] = elem;
2617 
  return list;
2618 
}
2619 
 
2620 
group_list new_group_list
2621 
    PROTO_N ( (n) )
2622 
    PROTO_T ( int n )
2623 
{
2624 
  UNUSED(n);
2625 
  crt_group_type = group_type(crt_capsule_groups[0].ints.chars);
2626 
  return 0;
2627 
}
2628 
 
2629 
group_list add_group_list
2630 
    PROTO_N ( (list, elem, index) )
2631 
    PROTO_T ( group_list list X group elem X int index )
2632 
{
2633 
  UNUSED(list); UNUSED(elem);
2634 
  if (index < (crt_capsule_group_no-1))
2635 
    crt_group_type = group_type(crt_capsule_groups[index+1].ints.chars);
2636 
  return 0;
2637 
}
2638 
 
2639 
links_list new_links_list
2640 
    PROTO_N ( (n) )
2641 
    PROTO_T ( int n )
2642 
{
2643 
  UNUSED(n);
2644 
  if (crt_capsule_link_no != 0)
2645 
    crt_links_type = links_type(crt_capsule_linking.members[0].id);
2646 
  return 0;
2647 
}
2648 
 
2649 
links_list add_links_list
2650 
    PROTO_N ( (list, elem, index) )
2651 
    PROTO_T ( links_list list X links elem X int index )
2652 
{
2653 
  UNUSED(list); UNUSED(elem);
2654 
  if (index < (crt_capsule_linking.number-1))
2655 
    crt_links_type = links_type(crt_capsule_linking.members[index+1].id);
2656 
  return 0;
2657 
}
2658 
 
2659 
extern_link_list new_extern_link_list
2660 
    PROTO_N ( (n) )
2661 
    PROTO_T ( int n )
2662 
{
2663 
  UNUSED(n);
2664 
  if (crt_capsule_link_no != 0)
2665 
    crt_extern_link_type = links_type(crt_capsule_linking.members[0].id);
2666 
  return 0;
2667 
}
2668 
 
2669 
extern_link_list add_extern_link_list
2670 
    PROTO_N ( (list, elem, index) )
2671 
    PROTO_T ( extern_link_list list X extern_link elem X int index )
2672 
{
2673 
  UNUSED(list); UNUSED(elem);
2674 
  if (index < (crt_capsule_linking.number-1))
2675 
     crt_extern_link_type =
2676 
         links_type(crt_capsule_linking.members[index+1].id);
2677 
  return 0;
2678 
}
2679 
 
2680 
capsule_link_list new_capsule_link_list
2681 
    PROTO_N ( (n) )
2682 
    PROTO_T ( int n )
2683 
{
2684 
  capsule_link_list res;
2685 
  res.members = (capsule_link *)xcalloc(n, sizeof(capsule_link));
2686 
  res.number = n;
2687 
  return res;
2688 
}
2689 
 
2690 
capsule_link_list add_capsule_link_list
2691 
    PROTO_N ( (list, elem, index) )
2692 
    PROTO_T ( capsule_link_list list X capsule_link elem X int index )
2693 
{
2694 
  list.members[index] = elem;
2695 
  return list;
2696 
}
2697 
 
2698 
unit_list new_unit_list
2699 
    PROTO_N ( (n) )
2700 
    PROTO_T ( int n )
2701 
{
2702 
  UNUSED(n);
2703 
  return 0;
2704 
}
2705 
 
2706 
unit_list add_unit_list
2707 
    PROTO_N ( (list, elem, index) )
2708 
    PROTO_T ( unit_list list X unit elem X int index )
2709 
{
2710 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2711 
  return 0;
2712 
}
2713 
 
2714 
link_list new_link_list
2715 
    PROTO_N ( (n) )
2716 
    PROTO_T ( int n )
2717 
{
2718 
  int i;
2719 
  switch (crt_links_type)
2720 
   {
2721 
       /* initialise the table */
2722 
     case TOK_TYPE:
2723 
       no_of_local_tokens = unit_no_of_tokens - n;
2724 
       unit_toktab = (tok_define *)xcalloc(no_of_local_tokens,
2725 
                         sizeof(tok_define));
2726 
       for (i = 0; i < no_of_local_tokens; ++i) {
2727 
         tok_define * tp = &unit_toktab[i];
2728 
         tp -> tok_special = 0;
2729 
         tp -> valpresent = 0;
2730 
         tp -> unit_number = crt_tagdef_unit_no;
2731 
         tp -> defined = 0;
2732 
         tp -> tok_index = i;
2733 
         tp -> is_capsule_token = 0;
2734 
         tp -> recursive = 0;
2735 
       };
2736 
       return 0;
2737 
     case TAG_TYPE:
2738 
       unit_tagtab = (dec *)xcalloc(unit_no_of_tags - n,
2739 
                         sizeof(dec));
2740 
       for (i = 0; i < unit_no_of_tags - n; ++i) {
2741 
         dec * dp = &unit_tagtab[i];
2742 
         dp -> dec_u.dec_val.dec_outermost = 0;
2743 
         dp -> dec_u.dec_val.dec_id = (char *) 0;
2744 
         dp -> dec_u.dec_val.extnamed = 0;
2745 
         dp -> dec_u.dec_val.diag_info = (diag_global *)0;
2746 
         dp -> dec_u.dec_val.have_def = 0;
2747 
         dp -> dec_u.dec_val.dec_shape = nilexp;
2748 
         dp -> dec_u.dec_val.processed = 0;
2749 
         dp -> dec_u.dec_val.isweak = 0;
2750 
         dp -> dec_u.dec_val.dec_exp = nilexp;
2751 
       };
2752 
       return 0;
2753 
     case AL_TYPE:
2754 
       unit_altab = (aldef *)xcalloc(unit_no_of_als - n,
2755 
                         sizeof(aldef));
2756 
       for (i = 0; i < unit_no_of_als - n; ++i) {
2757 
         aldef * ap = &unit_altab[i];
2758 
         ap -> al.al_n = 0;
2759 
       };
2760 
       return 0;
2761 
     case DIAGTAG_TYPE:		/* OLD DIAGS */
2762 
       init_unit_diagtags(n);
2763 
       return 0;
2764 
     case DGTAG_TYPE:		/* NEW DIAGS */
2765 
       init_unit_dgtags(n);
2766 
       return 0;
2767 
     default:
2768 
       failer(LINK_TYPE);
2769 
       return 0;
2770 
   };
2771 
}
2772 
 
2773 
link_list add_link_list
2774 
    PROTO_N ( (list, elem, index) )
2775 
    PROTO_T ( link_list list X link elem X int index )
2776 
{
2777 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2778 
  return 0;
2779 
}
2780 
 
2781 
linkextern_list new_linkextern_list
2782 
    PROTO_N ( (n) )
2783 
    PROTO_T ( int n )
2784 
{
2785 
  UNUSED(n);
2786 
  return 0;
2787 
}
2788 
 
2789 
linkextern_list add_linkextern_list
2790 
    PROTO_N ( (list, elem, index) )
2791 
    PROTO_T ( linkextern_list list X linkextern elem X int index )
2792 
{
2793 
  UNUSED(list); UNUSED(elem); UNUSED(index);
2794 
  return 0;
2795 
}
2796 
 
2797 
 
2798 
 
2799 
 
2800 
exp_option no_exp_option;
2801 
 
2802 
exp_option yes_exp_option
2803 
    PROTO_N ( (elem) )
2804 
    PROTO_T ( exp elem )
2805 
{
2806 
  exp_option res;
2807 
  res.present = 1;
2808 
  res.val = elem;
2809 
  return res;
2810 
}
2811 
 
2812 
void init_exp_option
2813 
    PROTO_Z ()
2814 
{
2815 
   no_exp_option.present = 0;
2816 
   return;
2817 
}
2818 
 
2819 
tag_option no_tag_option;
2820 
 
2821 
tag_option yes_tag_option
2822 
    PROTO_N ( (elem) )
2823 
    PROTO_T ( tag elem )
2824 
{
2825 
  tag_option res;
2826 
  res.present = 1;
2827 
  res.val = elem;
2828 
  return res;
2829 
}
2830 
 
2831 
void init_tag_option
2832 
    PROTO_Z ()
2833 
{
2834 
   no_tag_option.present = 0;
2835 
   return;
2836 
}
2837 
 
2838 
void init_capsule_link
2839 
    PROTO_Z ()
2840 
{
2841 
  return;
2842 
}
2843 
 
2844 
 
2845 
void init_extern_link
2846 
    PROTO_Z ()
2847 
{
2848 
  return;
2849 
}
2850 
 
2851 
void init_group
2852 
    PROTO_Z ()
2853 
{
2854 
  return;
2855 
}
2856 
 
2857 
void init_unit
2858 
    PROTO_Z ()
2859 
{
2860 
  return;
2861 
}
2862 
 
2863 
void init_link
2864 
    PROTO_Z ()
2865 
{
2866 
  return;
2867 
}
2868 
 
2869 
void init_linkextern
2870 
    PROTO_Z ()
2871 
{
2872 
  return;
2873 
}
2874 
 
2875 
void init_links
2876 
    PROTO_Z ()
2877 
{
2878 
  return;
2879 
}
2880 
 
2881 
void init_tagdec_props
2882 
    PROTO_Z ()
2883 
{
2884 
  return;
2885 
}
2886 
 
2887 
void init_tagdef_props
2888 
    PROTO_Z ()
2889 
{
2890 
  return;
2891 
}
2892 
 
2893 
void init_al_tagdef_props
2894 
    PROTO_Z ()
2895 
{
2896 
  return;
2897 
}
2898 
 
2899 
void init_tokdec_props
2900 
    PROTO_Z ()
2901 
{
2902 
  return;
2903 
}
2904 
 
2905 
void init_tokdef_props
2906 
    PROTO_Z ()
2907 
{
2908 
  return;
2909 
}
2910 
 
2911 
 
2912 
 
2913 
 
2914