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

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

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

Subversion Repositories tendra.SVN

Rev

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

Rev 2 Rev 7
Line -... Line 1...
- 
 
 1 
/*
- 
 
 2 
 * Copyright (c) 2002-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 
*/
Line 39... Line 69...
39 
#include "token.h"
 69 
#include "token.h"
40 
#include "type_ops.h"
 70 
#include "type_ops.h"
41 
 
 71 
 
42 
 
 72 
 
43 
/*
 73 
/*
44 
    PRINT SIMPLE TOKENS
 74 
 * PRINT SIMPLE TOKENS
- 
 
 75 
 *
- 
 
 76 
 * This routine prints the simple tokens for a type named nm with short
- 
 
 77 
 * name ns.  e is true for simply dereferenced types.
- 
 
 78 
 */
45 
 
 79 
 
46 
    This routine prints the simple tokens for a type named nm with short
 - 
 
47 
    name ns.  e is true for simply dereferenced types.
 - 
 
48 
*/
 - 
 
49 
 
 - 
 
50 
static void print_simple_tok
 80 
static void
51 
    PROTO_N ( ( nm, ns, e, lst ) )
 - 
 
52 
    PROTO_T ( char *nm X char *ns X int e X int lst )
 81 
print_simple_tok(char *nm, char *ns, int e, int lst)
53 
{
 82 
{
54 
    /* SIZE token */
 83 
    /* SIZE token */
55 
    output ( "%pt %xc : SIZE ( %e ) : SIZE_%e #\n\n", nm, ns ) ;
 84 
    output("%pt %xc : SIZE(%e) : SIZE_%e #\n\n", nm, ns);
56 
 
 85 
 
57 
    /* Assign token */
 86 
    /* Assign token */
58 
    output ( "%pt PROC (\\\n" ) ;
 87 
    output("%pt PROC(\\\n");
59 
    output ( "\t%xr : PTR ( %e ) :,\\\n\t%xr : %e :\\\n    ) ", nm, nm ) ;
 88 
    output("\t%xr : PTR(%e) :,\\\n\t%xr : %e :\\\n    ) ", nm, nm);
60 
    output ( e ? "%xr : void :" : "STATEMENT" ) ;
 89 
    output(e ? "%xr : void :" : "STATEMENT");
61 
    output ( " COPY_%e #\n\n", ns ) ;
 90 
    output(" COPY_%e #\n\n", ns);
62 
 
 91 
 
63 
    /* Dereference token */
 92 
    /* Dereference token */
64 
    output ( "%pt PROC (\\\n" ) ;
 93 
    output("%pt PROC(\\\n");
65 
    output ( "\t%xr : PTR ( %e ) :", nm ) ;
 94 
    output("\t%xr : PTR(%e) :", nm);
66 
    if ( e ) {
 95 
    if (e) {
67 
	output ( "\\\n    ) %xr : %e :", nm ) ;
 96 
	output("\\\n    ) %xr : %e :", nm);
68 
    } else {
 97 
    } else {
69 
	output ( ",\\\n\t%xl : %e :\\\n    ) STATEMENT", nm ) ;
 98 
	output(",\\\n\t%xl : %e :\\\n    ) STATEMENT", nm);
70 
    }
 99 
    }
71 
    output ( " DEREF_%e #\n\n", ns ) ;
 100 
    output(" DEREF_%e #\n\n", ns);
72 
 
 101 
 
73 
    if ( lst ) {
 102 
    if (lst) {
74 
	/* CONS token */
 103 
	/* CONS token */
75 
	output ( "%pt PROC (\\\n" ) ;
 104 
	output("%pt PROC(\\\n");
76 
	output ( "\t%xr : %e :,\\\n\t%xr : LIST ( %e ) :,\\\n", nm, nm ) ;
 105 
	output("\t%xr : %e :,\\\n\t%xr : LIST(%e) :,\\\n", nm, nm);
77 
	output ( "\t%xl : LIST ( %e ) :\\\n", nm ) ;
 106 
	output("\t%xl : LIST(%e) :\\\n", nm);
78 
	output ( "    ) STATEMENT CONS_%e #\n\n", ns ) ;
 107 
	output("    ) STATEMENT CONS_%e #\n\n", ns);
79 
 
 108 
 
80 
	/* UN_CONS token */
 109 
	/* UN_CONS token */
81 
	output ( "%pt PROC (\\\n" ) ;
 110 
	output("%pt PROC(\\\n");
82 
	output ( "\t%xl : %e :,\\\n", nm ) ;
 111 
	output("\t%xl : %e :,\\\n", nm);
83 
	output ( "\t%xl : LIST ( %e ) :,\\\n", nm ) ;
 112 
	output("\t%xl : LIST(%e) :,\\\n", nm);
84 
	output ( "\t%xr : LIST ( %e ) :\\\n", nm ) ;
 113 
	output("\t%xr : LIST(%e) :\\\n", nm);
85 
	output ( "    ) STATEMENT UN_CONS_%e #\n\n", ns ) ;
 114 
	output("    ) STATEMENT UN_CONS_%e #\n\n", ns);
86 
 
 115 
 
87 
	/* DESTROY_CONS token */
 116 
	/* DESTROY_CONS token */
88 
	output ( "%pt PROC (\\\n" ) ;
 117 
	output("%pt PROC(\\\n");
89 
	output ( "\t%xr : DESTROYER :,\\\n\t%xl : %e :,\\\n", nm ) ;
 118 
	output("\t%xr : DESTROYER :,\\\n\t%xl : %e :,\\\n", nm);
90 
	output ( "\t%xl : LIST ( %e ) :,\\\n", nm ) ;
 119 
	output("\t%xl : LIST(%e) :,\\\n", nm);
91 
	output ( "\t%xr : LIST ( %e ) :\\\n", nm ) ;
 120 
	output("\t%xr : LIST(%e) :\\\n", nm);
92 
	output ( "    ) STATEMENT DESTROY_CONS_%e #\n\n", ns ) ;
 121 
	output("    ) STATEMENT DESTROY_CONS_%e #\n\n", ns);
93 
 
 122 
 
94 
	if ( allow_stack ) {
 123 
	if (allow_stack) {
95 
	    /* PUSH token */
 124 
	    /* PUSH token */
96 
	    output ( "%pt PROC (\\\n" ) ;
 125 
	    output("%pt PROC(\\\n");
97 
	    output ( "\t%xr : %e :,\\\n", nm ) ;
 126 
	    output("\t%xr : %e :,\\\n", nm);
98 
	    output ( "\t%xl : STACK ( %e ) :\\\n", nm ) ;
 127 
	    output("\t%xl : STACK(%e) :\\\n", nm);
99 
	    output ( "    ) STATEMENT PUSH_%e #\n\n", ns ) ;
 128 
	    output("    ) STATEMENT PUSH_%e #\n\n", ns);
100 
 
 129 
 
101 
	    /* POP token */
 130 
	    /* POP token */
102 
	    output ( "%pt PROC (\\\n" ) ;
 131 
	    output("%pt PROC(\\\n");
103 
	    output ( "\t%xl : %e :,\\\n", nm ) ;
 132 
	    output("\t%xl : %e :,\\\n", nm);
104 
	    output ( "\t%xl : STACK ( %e ) :\\\n", nm ) ;
 133 
	    output("\t%xl : STACK(%e) :\\\n", nm);
105 
	    output ( "    ) STATEMENT POP_%e #\n\n", ns ) ;
 134 
	    output("    ) STATEMENT POP_%e #\n\n", ns);
106 
	}
 135 
	}
107 
    }
 136 
    }
108 
 
 137 
 
109 
    /* Interface commands */
 138 
    /* Interface commands */
110 
    output ( "%pi SIZE_%e COPY_%e DEREF_%e\n", ns, ns, ns ) ;
 139 
    output("%pi SIZE_%e COPY_%e DEREF_%e\n", ns, ns, ns);
111 
    if ( lst ) {
 140 
    if (lst) {
112 
	output ( "%pi CONS_%e UN_CONS_%e DESTROY_CONS_%e\n", ns, ns, ns ) ;
 141 
	output("%pi CONS_%e UN_CONS_%e DESTROY_CONS_%e\n", ns, ns, ns);
- 
 
 142 
	if (allow_stack) {
113 
	if ( allow_stack ) output ( "%pi PUSH_%e POP_%e\n", ns, ns ) ;
 143 
		output("%pi PUSH_%e POP_%e\n", ns, ns);
- 
 
 144 
	}
114 
    }
 145 
    }
115 
    output ( "\n\n" ) ;
 146 
    output("\n\n");
116 
    return ;
 147 
    return;
117 
}
 148 
}
118 
 
 149 
 
119 
 
 150 
 
120 
/*
 151 
/*
121 
    PRINT SIMPLE TOKENS FOR TYPE OPERATIONS
 152 
 * PRINT SIMPLE TOKENS FOR TYPE OPERATIONS
122 
 
 153 
 *
123 
    This routine prints the simple tokens for the type operation op.
 154 
 * This routine prints the simple tokens for the type operation op.
124 
    The tokens are named using nm.  e is true for simply dereferenced types.
 155 
 * The tokens are named using nm.  e is true for simply dereferenced types.
125 
*/
 156 
 */
126 
 
 157 
 
127 
static void print_type_ops_tok
 158 
static void
128 
    PROTO_N ( ( op, nm, e ) )
 - 
 
129 
    PROTO_T ( char *op X char *nm X int e )
 159 
print_type_ops_tok(char *op, char *nm, int e)
130 
{
 160 
{
131 
    /* Size token */
 161 
    /* Size token */
132 
    output ( "%pt PROC (\\\n\tTYPE t\\\n" ) ;
 162 
    output("%pt PROC(\\\n\tTYPE t\\\n");
133 
    output ( "    ) %xc : SIZE ( %s ( t ) ) : SIZE_%s #\n\n", op, nm ) ;
 163 
    output("    ) %xc : SIZE(%s(t)) : SIZE_%s #\n\n", op, nm);
134 
 
 164 
 
135 
    /* Assign token */
 165 
    /* Assign token */
136 
    output ( "%pt PROC {\\\n" ) ;
 166 
    output("%pt PROC {\\\n");
137 
    output ( "\tTYPE t, %xr : PTR ( %s ( t ) ) : e1,\\\n", op ) ;
 167 
    output("\tTYPE t, %xr : PTR(%s(t)) : e1,\\\n", op);
138 
    output ( "\t%xr : %s ( t ) : e2 |\\\n", op ) ;
 168 
    output("\t%xr : %s(t) : e2 |\\\n", op);
139 
    output ( "\tEXP e1, EXP e2\\\n    } " ) ;
 169 
    output("\tEXP e1, EXP e2\\\n    } ");
140 
    output ( e ? "%xr : void :" : "STATEMENT" ) ;
 170 
    output(e ? "%xr : void :" : "STATEMENT");
141 
    output ( " COPY_%s #\n\n", nm ) ;
 171 
    output(" COPY_%s #\n\n", nm);
142 
 
 172 
 
143 
    /* Dereference token */
 173 
    /* Dereference token */
144 
    output ( "%pt PROC {\\\n" ) ;
 174 
    output("%pt PROC {\\\n");
145 
    output ( "\tTYPE t, %xr : PTR ( %s ( t ) ) : e", op ) ;
 175 
    output("\tTYPE t, %xr : PTR(%s(t)) : e", op);
146 
    if ( e ) {
 176 
    if (e) {
147 
	output ( " |\\\n\tEXP e\\\n" ) ;
 177 
	output(" |\\\n\tEXP e\\\n");
148 
	output ( "    } %xr : %s ( t ) : ", op ) ;
 178 
	output("    } %xr : %s(t) : ", op);
149 
    } else {
 179 
    } else {
150 
	output ( "1,\\\n\t%xl : %s ( t ) : e2 |\\\n", op ) ;
 180 
	output("1,\\\n\t%xl : %s(t) : e2 |\\\n", op);
151 
	output ( "\tEXP e1, EXP e2\\\n" ) ;
 181 
	output("\tEXP e1, EXP e2\\\n");
152 
	output ( "    } STATEMENT " ) ;
 182 
	output("    } STATEMENT ");
153 
    }
 183 
    }
154 
    output ( "DEREF_%s #\n\n", nm ) ;
 184 
    output("DEREF_%s #\n\n", nm);
155 
 
 185 
 
156 
    /* CONS token */
 186 
    /* CONS token */
157 
    output ( "%pt PROC {\\\n" ) ;
 187 
    output("%pt PROC {\\\n");
158 
    output ( "\tTYPE t, %xr : %s ( t ) : e2,\\\n", op ) ;
 188 
    output("\tTYPE t, %xr : %s(t) : e2,\\\n", op);
159 
    output ( "\t%xr : LIST ( %s ( t ) ) : e3,\\\n", op ) ;
 189 
    output("\t%xr : LIST(%s(t)) : e3,\\\n", op);
160 
    output ( "\t%xl : LIST ( %s ( t ) ) : e4 |\\\n", op ) ;
 190 
    output("\t%xl : LIST(%s(t)) : e4 |\\\n", op);
161 
    output ( "\tEXP e2, EXP e3, EXP e4\\\n" ) ;
 191 
    output("\tEXP e2, EXP e3, EXP e4\\\n");
162 
    output ( "    } STATEMENT CONS_%s #\n\n", nm ) ;
 192 
    output("    } STATEMENT CONS_%s #\n\n", nm);
163 
 
 193 
 
164 
    /* UN_CONS token */
 194 
    /* UN_CONS token */
165 
    output ( "%pt PROC {\\\n" ) ;
 195 
    output("%pt PROC {\\\n");
166 
    output ( "\tTYPE t, %xl : %s ( t ) : e2,\\\n", op ) ;
 196 
    output("\tTYPE t, %xl : %s(t) : e2,\\\n", op);
167 
    output ( "\t%xl : LIST ( %s ( t ) ) : e3,\\\n", op ) ;
 197 
    output("\t%xl : LIST(%s(t)) : e3,\\\n", op);
168 
    output ( "\t%xr : LIST ( %s ( t ) ) : e4 |\\\n", op ) ;
 198 
    output("\t%xr : LIST(%s(t)) : e4 |\\\n", op);
169 
    output ( "\tEXP e2, EXP e3, EXP e4\\\n" ) ;
 199 
    output("\tEXP e2, EXP e3, EXP e4\\\n");
170 
    output ( "    } STATEMENT UN_CONS_%s #\n\n", nm ) ;
 200 
    output("    } STATEMENT UN_CONS_%s #\n\n", nm);
171 
 
 201 
 
172 
    /* DESTROY_CONS token */
 202 
    /* DESTROY_CONS token */
173 
    output ( "%pt PROC {\\\n" ) ;
 203 
    output("%pt PROC {\\\n");
174 
    output ( "\tTYPE t, %xr : DESTROYER : e1,\\\n" ) ;
 204 
    output("\tTYPE t, %xr : DESTROYER : e1,\\\n");
175 
    output ( "\t%xl : %s ( t ) : e2,\\\n", op ) ;
 205 
    output("\t%xl : %s(t) : e2,\\\n", op);
176 
    output ( "\t%xl : LIST ( %s ( t ) ) : e3,\\\n", op ) ;
 206 
    output("\t%xl : LIST(%s(t)) : e3,\\\n", op);
177 
    output ( "\t%xr : LIST ( %s ( t ) ) : e4 |\\\n", op ) ;
 207 
    output("\t%xr : LIST(%s(t)) : e4 |\\\n", op);
178 
    output ( "\tEXP e1, EXP e2, EXP e3, EXP e4\\\n" ) ;
 208 
    output("\tEXP e1, EXP e2, EXP e3, EXP e4\\\n");
179 
    output ( "    } STATEMENT DESTROY_CONS_%s #\n\n", nm ) ;
 209 
    output("    } STATEMENT DESTROY_CONS_%s #\n\n", nm);
180 
 
 210 
 
181 
    if ( allow_stack ) {
 211 
    if (allow_stack) {
182 
	/* PUSH token */
 212 
	/* PUSH token */
183 
	output ( "%pt PROC {\\\n" ) ;
 213 
	output("%pt PROC {\\\n");
184 
	output ( "\tTYPE t, %xr : %s ( t ) : e2,\\\n", op ) ;
 214 
	output("\tTYPE t, %xr : %s(t) : e2,\\\n", op);
185 
	output ( "\t%xl : STACK ( %s ( t ) ) : e3 |\\\n", op ) ;
 215 
	output("\t%xl : STACK(%s(t)) : e3 |\\\n", op);
186 
	output ( "\tEXP e2, EXP e3\\\n" ) ;
 216 
	output("\tEXP e2, EXP e3\\\n");
187 
	output ( "    } STATEMENT PUSH_%s #\n\n", nm ) ;
 217 
	output("    } STATEMENT PUSH_%s #\n\n", nm);
188 
 
 218 
 
189 
	/* POP token */
 219 
	/* POP token */
190 
	output ( "%pt PROC {\\\n" ) ;
 220 
	output("%pt PROC {\\\n");
191 
	output ( "\tTYPE t, %xl : %s ( t ) : e2,\\\n", op ) ;
 221 
	output("\tTYPE t, %xl : %s(t) : e2,\\\n", op);
192 
	output ( "\t%xl : STACK ( %s ( t ) ) : e3 |\\\n", op ) ;
 222 
	output("\t%xl : STACK(%s(t)) : e3 |\\\n", op);
193 
	output ( "\tEXP e2, EXP e3\\\n" ) ;
 223 
	output("\tEXP e2, EXP e3\\\n");
194 
	output ( "    } STATEMENT POP_%s #\n\n", nm ) ;
 224 
	output("    } STATEMENT POP_%s #\n\n", nm);
195 
    }
 225 
    }
196 
 
 226 
 
197 
    /* Interface commands */
 227 
    /* Interface commands */
198 
    output ( "%pi SIZE_%s COPY_%s DEREF_%s\n", nm, nm, nm ) ;
 228 
    output("%pi SIZE_%s COPY_%s DEREF_%s\n", nm, nm, nm);
199 
    output ( "%pi CONS_%s UN_CONS_%s DESTROY_CONS_%s\n", nm, nm, nm ) ;
 229 
    output("%pi CONS_%s UN_CONS_%s DESTROY_CONS_%s\n", nm, nm, nm);
- 
 
 230 
    if (allow_stack) {
200 
    if ( allow_stack ) output ( "%pi PUSH_%s POP_%s\n", nm, nm ) ;
 231 
	    output("%pi PUSH_%s POP_%s\n", nm, nm);
- 
 
 232 
    }
201 
    output ( "\n\n" ) ;
 233 
    output("\n\n");
202 
    return ;
 234 
    return;
203 
}
 235 
}
204 
 
 236 
 
205 
 
 237 
 
206 
/*
 238 
/*
207 
    PRINT BASIC TYPES (TOKEN VERSION)
 239 
 * PRINT BASIC TYPES (TOKEN VERSION)
208 
 
 240 
 *
209 
    This routine prints the token versions of the basic type definitions.
 241 
 * This routine prints the token versions of the basic type definitions.
210 
*/
 242 
 */
211 
 
 243 
 
212 
static void print_types_tok
 244 
static void
213 
    PROTO_Z ()
 245 
print_types_tok(void)
214 
{
 246 
{
215 
    comment ( "Primitive types" ) ;
 247 
    comment("Primitive types");
216 
    LOOP_PRIMITIVE {
 248 
    LOOP_PRIMITIVE {
217 
	CLASS_ID_P c = DEREF_ptr ( prim_id ( CRT_PRIMITIVE ) ) ;
 249 
	CLASS_ID_P c = DEREF_ptr(prim_id(CRT_PRIMITIVE));
218 
	char *pn = DEREF_string ( cid_name ( c ) ) ;
 250 
	char *pn = DEREF_string(cid_name(c));
219 
	char *pd = DEREF_string ( prim_defn ( CRT_PRIMITIVE ) ) ;
 251 
	char *pd = DEREF_string(prim_defn(CRT_PRIMITIVE));
- 
 
 252 
	if (!streq(pn, pd)) {
220 
	if ( !streq ( pn, pd ) ) output ( "typedef %PD %PN ;\n" ) ;
 253 
		output("typedef %PD %PN;\n");
- 
 
 254 
	}
221 
    }
 255 
    }
222 
    output ( "\n\n" ) ;
 256 
    output("\n\n");
223 
 
 257 
 
224 
    comment ( "Basic types" ) ;
 258 
    comment("Basic types");
225 
    output ( "#ifndef %X_DESTR_DEFINED\n" ) ;
 259 
    output("#ifndef %X_DESTR_DEFINED\n");
226 
    output ( "#define %X_DESTR_DEFINED\n" ) ;
 260 
    output("#define %X_DESTR_DEFINED\n");
227 
    output ( "typedef void ( *DESTROYER ) () ;\n" ) ;
 261 
    output("typedef void (*DESTROYER)();\n");
228 
    output ( "#endif\n\n" ) ;
 262 
    output("#endif\n\n");
229 
    output ( "%pt PROC ( TYPE ) TYPE PTR #\n" ) ;
 263 
    output("%pt PROC(TYPE) TYPE PTR #\n");
230 
    output ( "%pt PROC ( TYPE ) TYPE LIST #\n" ) ;
 264 
    output("%pt PROC(TYPE) TYPE LIST #\n");
231 
    if ( allow_stack ) {
 265 
    if (allow_stack) {
232 
	output ( "%pt PROC ( TYPE ) TYPE STACK #\n" ) ;
 266 
	output("%pt PROC(TYPE) TYPE STACK #\n");
- 
 
 267 
    }
- 
 
 268 
    if (allow_vec) {
- 
 
 269 
	output("%pt VARIETY %X_dim #\n");
- 
 
 270 
	output("%pt PROC(TYPE) TYPE VEC #\n");
- 
 
 271 
	output("%pt PROC(TYPE) TYPE VEC_PTR #\n");
- 
 
 272 
    }
- 
 
 273 
    output("%pt PROC(TYPE) TYPE SIZE #\n\n");
- 
 
 274 
    output("%pi PTR LIST ");
- 
 
 275 
    if (allow_stack) {
- 
 
 276 
	    output("STACK ");
- 
 
 277 
    }
- 
 
 278 
    if (allow_vec) {
- 
 
 279 
	    output("%X_dim VEC VEC_PTR ");
- 
 
 280 
    }
- 
 
 281 
    output("SIZE\n\n\n");
- 
 
 282 
 
- 
 
 283 
    comment("Enumeration type definitions");
- 
 
 284 
    LOOP_ENUM {
- 
 
 285 
	output("%pt VARIETY %EN #\n");
- 
 
 286 
	output("%pi %EN\n");
233 
    }
 287 
    }
234 
    if ( allow_vec ) {
 288 
    output("\n\n");
- 
 
 289 
 
235 
	output ( "%pt VARIETY %X_dim #\n" ) ;
 290 
    comment("Union type definitions");
- 
 
 291 
    LOOP_UNION {
236 
	output ( "%pt PROC ( TYPE ) TYPE VEC #\n" ) ;
 292 
	output("%pt TYPE %UN #\n");
237 
	output ( "%pt PROC ( TYPE ) TYPE VEC_PTR #\n" ) ;
 293 
	output("%pi %UN\n");
238 
    }
 294 
    }
559 
 
 629 
 
560 
/*
 630 
/*
561 
    PRINT PRIMITIVE CONSTRUCTS (TOKEN VERSION)
 631 
 * PRINT STRUCTURE CONSTRUCTS (TOKEN VERSION)
- 
 
 632 
 *
- 
 
 633 
 * This routine prints the token versions of the structure constructs.
- 
 
 634 
 */
562 
 
 635 
 
563 
    This routine prints the token versions of the primitive constructs.
 - 
 
564 
*/
 - 
 
565 
 
 - 
 
566 
static void print_prim_tok
 636 
static void
567 
    PROTO_Z ()
 637 
print_struct_tok(void)
568 
{
 638 
{
569 
    comment ( "Definitions for primitive %PN" ) ;
 639 
    STRUCTURE_P base = DEREF_ptr(str_base(CRT_STRUCTURE));
570 
    print_simple_tok ( "%PN", "%PM", 1, 1 ) ;
 - 
 
571 
    return ;
 - 
 
572 
}
 - 
 
573 
 
 640 
 
- 
 
 641 
    comment("Definitions for structure %SN");
- 
 
 642 
    LOOP_STRUCTURE_COMPONENT {
- 
 
 643 
	output("%pt PROC(%xr : PTR(%SN) :) ");
- 
 
 644 
	output("%xr : PTR(%CT) : %SM_%CN #\n");
- 
 
 645 
	output("%pi %SM_%CN\n\n");
- 
 
 646 
    }
- 
 
 647 
    output("%pt PROC(\\\n");
- 
 
 648 
    LOOP_STRUCTURE_COMPONENT {
- 
 
 649 
	string v = DEREF_string(cmp_value(CRT_COMPONENT));
- 
 
 650 
	if (v == NULL) {
- 
 
 651 
		output("\t%xr : %CT :,\\\n");
- 
 
 652 
	}
- 
 
 653 
    }
- 
 
 654 
    output("\t%xr : PTR(%SN) :\\\n");
- 
 
 655 
    output("    ) STATEMENT MAKE_%SM #\n");
- 
 
 656 
    output("%pi MAKE_%SM\n\n");
- 
 
 657 
 
- 
 
 658 
    if (!IS_NULL_ptr(base)) {
- 
 
 659 
	CLASS_ID_P id = DEREF_ptr(str_id(base));
- 
 
 660 
	char *nt = DEREF_string(cid_name(id));
- 
 
 661 
	char *nm = DEREF_string(cid_name_aux(id));
- 
 
 662 
	output("%pt PROC(\\\n");
- 
 
 663 
	output("\t%xr : PTR(%SN) :\\\n");
- 
 
 664 
	output("    ) %xr : PTR(%s) : CONVERT_%SM_%s #\n", nt, nm);
- 
 
 665 
	output("%pi CONVERT_%SM_%s\n\n", nm);
- 
 
 666 
    }
- 
 
 667 
 
- 
 
 668 
    print_simple_tok("%SN", "%SM", 0, 1);
- 
 
 669 
    return;
- 
 
 670 
}
- 
 
 671 
 
- 
 
 672 
 
- 
 
 673 
/*
- 
 
 674 
 * PRINT UNION CONSTRUCTS (TOKEN VERSION)
- 
 
 675 
 *
- 
 
 676 
 * This routine prints the token versions of the union constructs.
- 
 
 677 
 */
- 
 
 678 
 
- 
 
 679 
static void
- 
 
 680 
print_union_tok(void)
- 
 
 681 
{
- 
 
 682 
    UNION_P base = DEREF_ptr(un_base(CRT_UNION));
574 
 
 683 
 
575 
/*
 - 
 
576 
    PRINT ENUMERATION CONSTRUCTS (TOKEN VERSION)
 684 
    comment("Definitions for union %UN");
577 
 
 - 
 
578 
    This routine prints the token versions of the enumeration constructs.
 685 
    output("#define ORDER_%UM ((unsigned)%UO)\n");
579 
*/
 - 
 
580 
 
 - 
 
581 
static void print_enum_tok
 686 
    output("%pt %xc : %UN : NULL_%UM #\n");
582 
    PROTO_Z ()
 - 
 
583 
{
 - 
 
584 
    int lst = DEREF_int ( en_lists ( CRT_ENUM ) ) ;
 687 
    output("%pt PROC(%xr : %UN :) %xr : int : IS_NULL_%UM #\n");
585 
    comment ( "Definitions for enumeration %EN" ) ;
 688 
    output("%pt PROC(%xr : %UN :, %xr : %UN :) ");
586 
    print_enum_consts () ;
 689 
    output("%xr : int : EQ_%UM #\n");
587 
    print_simple_tok ( "%EN", "%EM", 1, lst ) ;
 690 
    output("%pi NULL_%UM IS_NULL_%UM EQ_%UM\n\n");
588 
    return ;
 - 
 
589 
}
 - 
 
590 
 
 - 
 
591 
 
 - 
 
592 
/*
 - 
 
593 
    PRINT STRUCTURE CONSTRUCTS (TOKEN VERSION)
 - 
 
594 
 
 - 
 
595 
    This routine prints the token versions of the structure constructs.
 - 
 
596 
*/
 - 
 
597 
 
 691 
 
598 
static void print_struct_tok
 692 
    if (!IS_NULL_ptr(base)) {
- 
 
 693 
	CLASS_ID_P id = DEREF_ptr(un_id(base));
- 
 
 694 
	char *nt = DEREF_string(cid_name(id));
- 
 
 695 
	char *nm = DEREF_string(cid_name_aux(id));
- 
 
 696 
	output("%pt PROC(%xr : %UN :) %xr : %s : CONVERT_%UM_%s #\n",
599 
    PROTO_Z ()
 697 
		 nt, nm);
- 
 
 698 
	output("%pi CONVERT_%UM_%s\n\n", nm);
600 
{
 699 
    }
601 
    STRUCTURE_P base = DEREF_ptr ( str_base ( CRT_STRUCTURE ) ) ;
 - 
 
602 
 
 700 
 
603 
    comment ( "Definitions for structure %SN" ) ;
 - 
 
604 
    LOOP_STRUCTURE_COMPONENT {
 - 
 
605 
	output ( "%pt PROC ( %xr : PTR ( %SN ) : ) " )  ;
 - 
 
606 
	output ( "%xr : PTR ( %CT ) : %SM_%CN #\n" ) ;
 - 
 
607 
	output ( "%pi %SM_%CN\n\n" ) ;
 - 
 
608 
    }
 - 
 
609 
    output ( "%pt PROC (\\\n" ) ;
 - 
 
610 
    LOOP_STRUCTURE_COMPONENT {
 - 
 
611 
	string v = DEREF_string ( cmp_value ( CRT_COMPONENT ) ) ;
 - 
 
612 
	if ( v == NULL ) output ( "\t%xr : %CT :,\\\n" ) ;
 - 
 
613 
    }
 - 
 
614 
    output ( "\t%xr : PTR ( %SN ) :\\\n" ) ;
 - 
 
615 
    output ( "    ) STATEMENT MAKE_%SM #\n" ) ;
 - 
 
616 
    output ( "%pi MAKE_%SM\n\n" ) ;
 - 
 
617 
 
 - 
 
618 
    if ( !IS_NULL_ptr ( base ) ) {
 - 
 
619 
	CLASS_ID_P id = DEREF_ptr ( str_id ( base ) ) ;
 - 
 
620 
	char *nt = DEREF_string ( cid_name ( id ) ) ;
 - 
 
621 
	char *nm = DEREF_string ( cid_name_aux ( id ) ) ;
 - 
 
622 
	output ( "%pt PROC (\\\n" ) ;
 - 
 
623 
	output ( "\t%xr : PTR ( %SN ) :\\\n" ) ;
 - 
 
624 
	output ( "    ) %xr : PTR ( %s ) : CONVERT_%SM_%s #\n", nt, nm ) ;
 - 
 
625 
	output ( "%pi CONVERT_%SM_%s\n\n", nm ) ;
 - 
 
626 
    }
 - 
 
627 
 
 - 
 
628 
    print_simple_tok ( "%SN", "%SM", 0, 1 ) ;
 - 
 
629 
    return ;
 - 
 
630 
}
 - 
 
631 
 
 - 
 
632 
 
 - 
 
633 
/*
 - 
 
634 
    PRINT UNION CONSTRUCTS (TOKEN VERSION)
 - 
 
635 
 
 - 
 
636 
    This routine prints the token versions of the union constructs.
 - 
 
637 
*/
 - 
 
638 
 
 - 
 
639 
static void print_union_tok
 - 
 
640 
    PROTO_Z ()
 - 
 
641 
{
 - 
 
642 
    UNION_P base = DEREF_ptr ( un_base ( CRT_UNION ) ) ;
 - 
 
643 
 
 - 
 
644 
    comment ( "Definitions for union %UN" ) ;
 - 
 
645 
    output ( "#define ORDER_%UM ( ( unsigned ) %UO )\n" ) ;
 - 
 
646 
    output ( "%pt %xc : %UN : NULL_%UM #\n" ) ;
 - 
 
647 
    output ( "%pt PROC ( %xr : %UN : ) %xr : int : IS_NULL_%UM #\n" ) ;
 - 
 
648 
    output ( "%pt PROC ( %xr : %UN :, %xr : %UN : ) " ) ;
 - 
 
649 
    output ( "%xr : int : EQ_%UM #\n" ) ;
 - 
 
650 
    output ( "%pi NULL_%UM IS_NULL_%UM EQ_%UM\n\n" ) ;
 - 
 
651 
 
 - 
 
652 
    if ( !IS_NULL_ptr ( base ) ) {
 - 
 
653 
	CLASS_ID_P id = DEREF_ptr ( un_id ( base ) ) ;
 - 
 
654 
	char *nt = DEREF_string ( cid_name ( id ) ) ;
 - 
 
655 
	char *nm = DEREF_string ( cid_name_aux ( id ) ) ;
 - 
 
656 
	output ( "%pt PROC ( %xr : %UN : ) %xr : %s : CONVERT_%UM_%s #\n",
 - 
 
657 
		 nt, nm ) ;
 - 
 
658 
	output ( "%pi CONVERT_%UM_%s\n\n", nm ) ;
 - 
 
659 
    }
 - 
 
660 
 
 - 
 
661 
    print_simple_tok ( "%UN", "%UM", 1, 1 ) ;
 701 
    print_simple_tok("%UN", "%UM", 1, 1);
662 
    return ;
 702 
    return;
663 
}
 703 
}
664 
 
 704 
 
665 
 
 705 
 
666 
/*
 706 
/*
667 
    PRINT THE MAIN TOKEN OUTPUT FILE
 707 
 * PRINT THE MAIN TOKEN OUTPUT FILE
668 
 
 708 
 *
669 
    This routine prints the token specifications for the objects above.
 709 
 * This routine prints the token specifications for the objects above.
670 
*/
 710 
 */
671 
 
 711 
 
672 
static void print_main_tok
 712 
static void
673 
    PROTO_N ( ( dir ) )
 - 
 
674 
    PROTO_T ( char *dir )
 713 
print_main_tok(char *dir)
675 
{
 714 
{
676 
    open_file ( dir, MAIN_PREFIX, MAIN_SUFFIX ) ;
 715 
    open_file(dir, MAIN_PREFIX, MAIN_SUFFIX);
677 
    if ( extra_headers ) {
 716 
    if (extra_headers) {
678 
	output ( "#include \"%s_bscs.h\"\n\n", MAIN_PREFIX ) ;
 717 
	output("#include \"%s_bscs.h\"\n\n", MAIN_PREFIX);
679 
    }
 718 
    }
680 
    output ( "#ifndef %X_NAME\n" ) ;
 719 
    output("#ifndef %X_NAME\n");
681 
    output ( "#define %X_NAME%t40\"%X\"\n" ) ;
 720 
    output("#define %X_NAME%t40\"%X\"\n");
682 
    output ( "#define %X_VERSION%t40\"%V\"\n" ) ;
 721 
    output("#define %X_VERSION%t40\"%V\"\n");
683 
    output ( "#define %X_SPECIFICATION%t40%d\n", 1 ) ;
 722 
    output("#define %X_SPECIFICATION%t40%d\n", 1);
684 
    output ( "#define %X_IMPLEMENTATION%t40%d\n", 0 ) ;
 723 
    output("#define %X_IMPLEMENTATION%t40%d\n", 0);
685 
    output ( "#endif\n\n\n" ) ;
 724 
    output("#endif\n\n\n");
686 
 
 725 
 
687 
    print_proto () ;
 726 
    print_proto();
688 
    print_types_tok () ;
 727 
    print_types_tok();
689 
    print_ptr_tok () ;
 728 
    print_ptr_tok();
690 
    print_list_tok () ;
 729 
    print_list_tok();
691 
    if ( allow_stack ) {
 730 
    if (allow_stack) {
692 
	print_stack_tok () ;
 731 
	print_stack_tok();
693 
    }
 732 
    }
694 
    if ( allow_vec ) {
 733 
    if (allow_vec) {
695 
	print_vec_tok () ;
 734 
	print_vec_tok();
696 
	print_vec_ptr_tok () ;
 735 
	print_vec_ptr_tok();
697 
    }
 736 
    }
698 
    print_size_tok () ;
 737 
    print_size_tok();
699 
 
 738 
 
700 
    LOOP_PRIMITIVE print_prim_tok () ;
 739 
    LOOP_PRIMITIVE print_prim_tok();
701 
    LOOP_ENUM print_enum_tok () ;
 740 
    LOOP_ENUM print_enum_tok();
702 
    LOOP_STRUCTURE print_struct_tok () ;
 741 
    LOOP_STRUCTURE print_struct_tok();
703 
    LOOP_UNION print_union_tok () ;
 742 
    LOOP_UNION print_union_tok();
704 
 
 743 
 
705 
    if ( extra_headers ) {
 744 
    if (extra_headers) {
706 
	output ( "#include \"%s_term.h\"\n\n", MAIN_PREFIX ) ;
 745 
	output("#include \"%s_term.h\"\n\n", MAIN_PREFIX);
707 
    }
 746 
    }
708 
    close_file () ;
 747 
    close_file();
709 
    return ;
 748 
    return;
710 
}
 749 
}
711 
 
 750 
 
712 
 
 751 
 
713 
 
 752 
 
714 
/*
 753 
/*
715 
    PRINT ARGUMENTS FOR A TOKENISED UNION CONSTRUCTOR
 754 
 * PRINT ARGUMENTS FOR A TOKENISED UNION CONSTRUCTOR
716 
 
 755 
 *
717 
    This routine prints the list of arguments for a tokenised union
 756 
 * This routine prints the list of arguments for a tokenised union
718 
    constructor and similar functions.  lv is true if all the arguments
 757 
 * constructor and similar functions.  lv is true if all the arguments
719 
    are lvalues.
 758 
 * are lvalues.
720 
*/
 759 
 */
721 
 
 760 
 
722 
static void print_cons_tok_args
 761 
static void
723 
    PROTO_N ( ( lv, d ) )
 - 
 
724 
    PROTO_T ( int lv X int d )
 762 
print_cons_tok_args(int lv, int d)
725 
{
 763 
{
726 
    char *a = "%xr" ;
 764 
    char *a = "%xr";
727 
    char *b = "%xl" ;
 765 
    char *b = "%xl";
728 
    if ( lv ) {
 766 
    if (lv) {
729 
	char *c = a ;
 767 
	char *c = a;
730 
	a = b ;
 768 
	a = b;
731 
	b = c ;
 769 
	b = c;
732 
    }
 770 
    }
733 
    LOOP_UNION_COMPONENT {
 771 
    LOOP_UNION_COMPONENT {
734 
	string v = DEREF_string ( cmp_value ( CRT_COMPONENT ) ) ;
 772 
	string v = DEREF_string(cmp_value(CRT_COMPONENT));
- 
 
 773 
	if (v == NULL || d == 0) {
735 
	if ( v == NULL || d == 0 ) output ( "\\\n\t%e : %CT :,", a ) ;
 774 
		output("\\\n\t%e : %CT :,", a);
- 
 
 775 
	}
736 
    }
 776 
    }
737 
    LOOP_FIELD_COMPONENT {
 777 
    LOOP_FIELD_COMPONENT {
738 
	string v = DEREF_string ( cmp_value ( CRT_COMPONENT ) ) ;
 778 
	string v = DEREF_string(cmp_value(CRT_COMPONENT));
- 
 
 779 
	if (v == NULL || d == 0) {
739 
	if ( v == NULL || d == 0 ) output ( "\\\n\t%e : %CT :,", a ) ;
 780 
		output("\\\n\t%e : %CT :,", a);
- 
 
 781 
	}
740 
    }
 782 
    }
741 
    output ( "\\\n\t%e : %UN :", b ) ;
 783 
    output("\\\n\t%e : %UN :", b);
742 
    return ;
 784 
    return;
743 
}
 785 
}
744 
 
 786 
 
745 
 
 787 
 
746 
/*
 788 
/*
747 
    PRINT FIELD SELECTOR OPERATIONS
 789 
 * PRINT FIELD SELECTOR OPERATIONS
748 
 
 790 
 *
749 
    This routine prints the operations on field selectors (token version).
 791 
 * This routine prints the operations on field selectors (token version).
750 
    rng gives the number of elements in the field set (if appropriate).
 792 
 * rng gives the number of elements in the field set (if appropriate).
751 
    al is true if the field is aliased.
 793 
 * al is true if the field is aliased.
752 
*/
 794 
 */
753 
 
 795 
 
754 
static void print_field_tok
 796 
static void
755 
    PROTO_N ( ( rng, al ) )
 - 
 
756 
    PROTO_T ( int rng X int al )
 797 
print_field_tok(int rng, int al)
757 
{
 798 
{
758 
    char *f = ( rng ? "%FN_etc" : "%FN" ) ;
 799 
    char *f = (rng ? "%FN_etc" : "%FN");
759 
 
 800 
 
760 
    LOOP_FIELD_COMPONENT {
 801 
    LOOP_FIELD_COMPONENT {
761 
	output ( "%pt PROC ( %xr : %UN : )\\\n" ) ;
 802 
	output("%pt PROC(%xr : %UN :)\\\n");
762 
	output ( "    %xr : PTR ( %CT ) : " ) ;
 803 
	output("    %xr : PTR(%CT) : ");
763 
	output ( "%UM_%e_%CN #\n", f ) ;
 804 
	output("%UM_%e_%CN #\n", f);
764 
	output ( "%pi %UM_%e_%CN\n\n", f ) ;
 805 
	output("%pi %UM_%e_%CN\n\n", f);
765 
    }
 806 
    }
766 
 
 807 
 
767 
    /* Component constructor */
 808 
    /* Component constructor */
768 
    output ( "%pt PROC (" ) ;
 809 
    output("%pt PROC(");
- 
 
 810 
    if (rng) {
769 
    if ( rng ) output ( "\\\n\t%xr : unsigned :," ) ;
 811 
	    output("\\\n\t%xr : unsigned :,");
- 
 
 812 
    }
770 
    print_cons_tok_args ( 0, 1 ) ;
 813 
    print_cons_tok_args(0, 1);
771 
    output ( "\\\n    ) STATEMENT MAKE_%UM_%e #\n", f ) ;
 814 
    output("\\\n    ) STATEMENT MAKE_%UM_%e #\n", f);
772 
    output ( "%pi MAKE_%UM_%e\n\n", f ) ;
 815 
    output("%pi MAKE_%UM_%e\n\n", f);
773 
 
 816 
 
774 
    /* Tag modifier */
 817 
    /* Tag modifier */
775 
    if ( rng ) {
 818 
    if (rng) {
776 
	output ( "%pt PROC (" ) ;
 819 
	output("%pt PROC(");
777 
	output ( "\\\n\t%xr : unsigned :," ) ;
 820 
	output("\\\n\t%xr : unsigned :,");
778 
	output ( "\\\n\t%xr : %UN :" ) ;
 821 
	output("\\\n\t%xr : %UN :");
779 
	output ( "\\\n    ) STATEMENT MODIFY_%UM_%e #\n", f ) ;
 822 
	output("\\\n    ) STATEMENT MODIFY_%UM_%e #\n", f);
780 
	output ( "%pi MODIFY_%UM_%e\n\n", f ) ;
 823 
	output("%pi MODIFY_%UM_%e\n\n", f);
- 
 
 824 
    }
- 
 
 825 
 
- 
 
 826 
    /* Component deconstructor */
- 
 
 827 
    if (field_not_empty()) {
- 
 
 828 
	output("%pt PROC(");
- 
 
 829 
	print_cons_tok_args(1, 0);
- 
 
 830 
	output("\\\n    ) STATEMENT DECONS_%UM_%e #\n", f);
- 
 
 831 
	output("%pi DECONS_%UM_%e\n\n", f);
781 
    }
 832 
    }
782 
 
 833 
 
783 
    /* Component deconstructor */
 - 
 
784 
    if ( field_not_empty () ) {
 - 
 
785 
	output ( "%pt PROC (" ) ;
 - 
 
786 
	print_cons_tok_args ( 1, 0 ) ;
 - 
 
787 
	output ( "\\\n    ) STATEMENT DECONS_%UM_%e #\n", f ) ;
 - 
 
788 
	output ( "%pi DECONS_%UM_%e\n\n", f ) ;
 - 
 
789 
    }
 - 
 
790 
 
 - 
 
791 
    /* Component destructor */
 834 
    /* Component destructor */
792 
    output ( "%pt PROC (" ) ;
 835 
    output("%pt PROC(");
793 
    output ( "\\\n\t%xr : DESTROYER :," ) ;
 836 
    output("\\\n\t%xr : DESTROYER :,");
794 
    print_cons_tok_args ( 1, 0 ) ;
 837 
    print_cons_tok_args(1, 0);
795 
    output ( "\\\n    ) STATEMENT DESTROY_%UM_%e #\n", f ) ;
 838 
    output("\\\n    ) STATEMENT DESTROY_%UM_%e #\n", f);
796 
    output ( "%pi DESTROY_%UM_%e\n\n", f ) ;
 839 
    output("%pi DESTROY_%UM_%e\n\n", f);
797 
 
 840 
 
798 
    /* Aliasing tokens */
 841 
    /* Aliasing tokens */
799 
    if ( al && !rng ) {
 842 
    if (al && !rng) {
800 
	output ( "#ifdef %X_IO_ROUTINES\n\n" ) ;
 843 
	output("#ifdef %X_IO_ROUTINES\n\n");
801 
	output ( "%pt PROC (\\\n" ) ;
 844 
	output("%pt PROC(\\\n");
802 
	output ( "\t%xl : %UN :,\\\n" ) ;
 845 
	output("\t%xl : %UN :,\\\n");
803 
	output ( "\t%xr : unsigned :\\\n" ) ;
 846 
	output("\t%xr : unsigned :\\\n");
804 
	output ( "    ) STATEMENT NEW_ALIAS_%UM_%FN #\n" ) ;
 847 
	output("    ) STATEMENT NEW_ALIAS_%UM_%FN #\n");
805 
	output ( "%pi NEW_ALIAS_%UM_%FN\n\n" ) ;
 848 
	output("%pi NEW_ALIAS_%UM_%FN\n\n");
806 
 
 849 
 
807 
	output ( "%pt PROC ( %xr : %UN : )\\\n    " ) ;
 850 
	output("%pt PROC(%xr : %UN :)\\\n    ");
808 
	output ( "%xr : unsigned : GET_ALIAS_%UM_%FN #\n" ) ;
 851 
	output("%xr : unsigned : GET_ALIAS_%UM_%FN #\n");
809 
	output ( "%pt PROC ( %xr : %UN :, %xr : unsigned : )\\\n    " ) ;
 852 
	output("%pt PROC(%xr : %UN :, %xr : unsigned :)\\\n    ");
810 
	output ( "%xr : void : SET_ALIAS_%UM_%FN #\n" ) ;
 853 
	output("%xr : void : SET_ALIAS_%UM_%FN #\n");
811 
	output ( "%pt PROC ( %xr : unsigned : )\\\n    " ) ;
 854 
	output("%pt PROC(%xr : unsigned :)\\\n    ");
812 
	output ( "%xr : %UN : FIND_ALIAS_%UM_%FN #\n\n" ) ;
 855 
	output("%xr : %UN : FIND_ALIAS_%UM_%FN #\n\n");
813 
	output ( "%pi GET_ALIAS_%UM_%FN SET_ALIAS_%UM_%FN " ) ;
 856 
	output("%pi GET_ALIAS_%UM_%FN SET_ALIAS_%UM_%FN ");
814 
	output ( "FIND_ALIAS_%UM_%FN\n\n" ) ;
 857 
	output("FIND_ALIAS_%UM_%FN\n\n");
815 
	output ( "#endif\n\n" ) ;
 858 
	output("#endif\n\n");
816 
    }
 859 
    }
817 
    output ( "\n" ) ;
 860 
    output("\n");
818 
    return ;
 861 
    return;
819 
}
 862 
}
820 
 
 863 
 
821 
 
 864 
 
822 
/*
 865 
/*
823 
    PRINT THE UNION OPERATIONS OUTPUT FILE
 866 
 * PRINT THE UNION OPERATIONS OUTPUT FILE
824 
 
 867 
 *
825 
    For each union in the calculus there is an operations file.
 868 
 * For each union in the calculus there is an operations file.
826 
*/
 869 
 */
827 
 
 870 
 
828 
static void print_union_ops_tok
 871 
static void
829 
    PROTO_N ( ( dir, un ) )
 - 
 
830 
    PROTO_T ( char *dir X char *un )
 872 
print_union_ops_tok(char *dir, char *un)
831 
{
 873 
{
832 
    open_file ( dir, un, OPS_SUFFIX ) ;
 874 
    open_file(dir, un, OPS_SUFFIX);
833 
    if ( extra_headers ) {
 875 
    if (extra_headers) {
834 
	output ( "#include \"%s%s\"\n", MAIN_PREFIX, MAIN_SUFFIX ) ;
 876 
	output("#include \"%s%s\"\n", MAIN_PREFIX, MAIN_SUFFIX);
835 
	output ( "#include <%s_ops.h>\n\n", MAIN_PREFIX ) ;
 877 
	output("#include <%s_ops.h>\n\n", MAIN_PREFIX);
836 
    }
 878 
    }
837 
 
 879 
 
838 
    comment ( "Operations for union %UN" ) ;
 880 
    comment("Operations for union %UN");
839 
    output ( "%pt PROC ( %xr : %UN : ) %xr : unsigned : TAG_%UM #\n" ) ;
 881 
    output("%pt PROC(%xr : %UN :) %xr : unsigned : TAG_%UM #\n");
840 
    output ( "%pi TAG_%UM\n\n\n" ) ;
 882 
    output("%pi TAG_%UM\n\n\n");
841 
 
 883 
 
842 
    /* Operations on common components */
 884 
    /* Operations on common components */
843 
    LOOP_UNION_COMPONENT {
 885 
    LOOP_UNION_COMPONENT {
844 
	comment ( "Operations for component %CN of union %UN" ) ;
 886 
	comment("Operations for component %CN of union %UN");
845 
	output ( "%pt PROC ( %xr : %UN : )\\\n" ) ;
 887 
	output("%pt PROC(%xr : %UN :)\\\n");
846 
	output ( "    %xr : PTR ( %CT ) : %UM_%CN #\n" ) ;
 888 
	output("    %xr : PTR(%CT) : %UM_%CN #\n");
847 
	output ( "%pi %UM_%CN\n\n" ) ;
 889 
	output("%pi %UM_%CN\n\n");
848 
    }
 890 
    }
849 
 
 891 
 
850 
    /* Operations on field components */
 892 
    /* Operations on field components */
851 
    LOOP_UNION_FIELD {
 893 
    LOOP_UNION_FIELD {
852 
	int rng = DEREF_int ( fld_set ( CRT_FIELD ) ) ;
 894 
	int rng = DEREF_int(fld_set(CRT_FIELD));
853 
	int hash = DEREF_int ( fld_flag ( CRT_FIELD ) ) ;
 895 
	int hash = DEREF_int(fld_flag(CRT_FIELD));
854 
	int al = ( hash ? 1 : 0 ) ;
 896 
	int al = (hash ? 1 : 0);
855 
	if ( rng ) {
 897 
	if (rng) {
856 
	    comment ( "Operations for field set %FN_etc of union %UN" ) ;
 898 
	    comment("Operations for field set %FN_etc of union %UN");
857 
	    output ( "%pt %xc : unsigned : %UM_%FN_etc_tag #\n" ) ;
 899 
	    output("%pt %xc : unsigned : %UM_%FN_etc_tag #\n");
858 
	    output ( "%pt PROC ( %xr : %UN : ) " ) ;
 900 
	    output("%pt PROC(%xr : %UN :) ");
859 
	    output ( "%xr : int : IS_%UM_%FN_etc #\n" ) ;
 901 
	    output("%xr : int : IS_%UM_%FN_etc #\n");
860 
	    output ( "%pi %UM_%FN_etc_tag IS_%UM_%FN_etc\n\n" ) ;
 902 
	    output("%pi %UM_%FN_etc_tag IS_%UM_%FN_etc\n\n");
861 
	    print_field_tok ( rng, al ) ;
 903 
	    print_field_tok(rng, al);
862 
	}
 904 
	}
863 
 
 905 
 
864 
	comment ( "Operations for field %FN of union %UN" ) ;
 906 
	comment("Operations for field %FN of union %UN");
865 
	output ( "%pt %xc : unsigned : %UM_%FN_tag #\n" ) ;
 907 
	output("%pt %xc : unsigned : %UM_%FN_tag #\n");
866 
	output ( "%pt PROC ( %xr : %UN : ) %xr : int : IS_%UM_%FN #\n" ) ;
 908 
	output("%pt PROC(%xr : %UN :) %xr : int : IS_%UM_%FN #\n");
867 
	output ( "%pi %UM_%FN_tag IS_%UM_%FN\n\n" ) ;
 909 
	output("%pi %UM_%FN_tag IS_%UM_%FN\n\n");
868 
	print_field_tok ( 0, al ) ;
 910 
	print_field_tok(0, al);
869 
    }
 911 
    }
870 
 
 912 
 
871 
    /* Map tables */
 913 
    /* Map tables */
872 
    LOOP_UNION_MAP {
 914 
    LOOP_UNION_MAP {
873 
	int hash = DEREF_int ( map_flag ( CRT_MAP ) ) ;
 915 
	int hash = DEREF_int(map_flag(CRT_MAP));
874 
	comment ( "Map %MN on union %UN" ) ;
 916 
	comment("Map %MN on union %UN");
875 
	output ( "%pt PROC (\\\n" ) ;
 917 
	output("%pt PROC(\\\n");
876 
	output ( "\t%xr : %UN :" ) ;
 918 
	output("\t%xr : %UN :");
- 
 
 919 
	if (hash) {
877 
	if ( hash ) output ( ",\\\n\t%xr : DESTROYER :" ) ;
 920 
		output(",\\\n\t%xr : DESTROYER :");
- 
 
 921 
	}
878 
	LOOP_MAP_ARGUMENT output ( ",\\\n\t%xr : %AT :" ) ;
 922 
	LOOP_MAP_ARGUMENT output(",\\\n\t%xr : %AT :");
879 
	output ( "\\\n    ) %xr : %MR : %MN_%UM #\n " ) ;
 923 
	output("\\\n    ) %xr : %MR : %MN_%UM #\n ");
880 
	output ( "%pi %MN_%UM\n\n\n" ) ;
 924 
	output("%pi %MN_%UM\n\n\n");
881 
    }
 925 
    }
882 
 
 926 
 
883 
    /* End of file */
 927 
    /* End of file */
884 
    close_file () ;
 928 
    close_file();
885 
    return ;
 929 
    return;
886 
}
 930 
}
887 
 
 931 
 
888 
 
 932 
 
889 
/*
 933 
/*
890 
    MAIN ACTION (TOKEN VERSION)
 934 
 * MAIN ACTION (TOKEN VERSION)
891 
 
 935 
 *
892 
    This routine prints all the output files for the calculus (token
 936 
 * This routine prints all the output files for the calculus (token
893 
    version).
 937 
 * version).
894 
*/
 938 
 */
895 
 
 939 
 
896 
void main_action_tok
 940 
void
897 
    PROTO_N ( ( dir ) )
 - 
 
898 
    PROTO_T ( char *dir )
 941 
main_action_tok(char *dir)
899 
{
 942 
{
900 
    int ign = 0 ;
 943 
    int ign = 0;
901 
    output_c_code = 2 ;
 944 
    output_c_code = 2;
902 
    print_main_tok ( dir ) ;
 945 
    print_main_tok(dir);
903 
 
 946 
 
904 
    LOOP_UNION {
 947 
    LOOP_UNION {
905 
	LIST ( MAP_P ) maps ;
 948 
	LIST(MAP_P)maps;
906 
	CLASS_ID_P cid = DEREF_ptr ( un_id ( CRT_UNION ) ) ;
 949 
	CLASS_ID_P cid = DEREF_ptr(un_id(CRT_UNION));
907 
	char *un = DEREF_string ( cid_name_aux ( cid ) ) ;
 950 
	char *un = DEREF_string(cid_name_aux(cid));
908 
	print_union_ops_tok ( dir, un ) ;
 951 
	print_union_ops_tok(dir, un);
909 
	maps = DEREF_list ( un_map ( CRT_UNION ) ) ;
 952 
	maps = DEREF_list(un_map(CRT_UNION));
910 
	if ( !IS_NULL_list ( maps ) ) {
 953 
	if (!IS_NULL_list(maps)) {
911 
	    print_union_map_c ( dir, un ) ;
 954 
	    print_union_map_c(dir, un);
912 
	    print_union_hdr_c ( dir, un ) ;
 955 
	    print_union_hdr_c(dir, un);
913 
	    ign = 1 ;
 956 
	    ign = 1;
914 
        }
 957 
        }
915 
    }
 958 
    }
916 
 
 959 
 
917 
    if ( ign ) {
 960 
    if (ign) {
918 
	open_file ( dir, IGNORE_PREFIX, DEF_SUFFIX ) ;
 961 
	open_file(dir, IGNORE_PREFIX, DEF_SUFFIX);
919 
	comment ( "Map ignore macros" ) ;
 962 
	comment("Map ignore macros");
920 
	LOOP_UNION {
 963 
	LOOP_UNION {
921 
	    LOOP_UNION_MAP output ( "#define IGNORE_%MN_%UM%t40%d\n", 1 ) ;
 964 
	    LOOP_UNION_MAP output("#define IGNORE_%MN_%UM%t40%d\n", 1);
922 
	}
 965 
	}
923 
	output ( "\n" ) ;
 966 
	output("\n");
924 
	close_file () ;
 967 
	close_file();
925 
    }
 968 
    }
926 
 
 969 
 
927 
    if ( extra_asserts ) {
 970 
    if (extra_asserts) {
928 
	open_file ( dir, ASSERT_PREFIX, DEF_SUFFIX ) ;
 971 
	open_file(dir, ASSERT_PREFIX, DEF_SUFFIX);
929 
	comment ( "Dummy assertion function definitions" ) ;
 972 
	comment("Dummy assertion function definitions");
930 
	close_file () ;
 973 
	close_file();
931 
    }
 974 
    }
932 
    return ;
 975 
    return;
933 
}
 976 
}