WebSVN – tendra.SVN – Blame – /branches/tendra5-amd64/src/utilities/calculus/code.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
6	7u83	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	`*/`
		31	`/*`
2	7u83	32	`Crown Copyright (c) 1997`
6	7u83	33
2	7u83	34	`This TenDRA(r) Computer Program is subject to Copyright`
		35	`owned by the United Kingdom Secretary of State for Defence`
		36	`acting through the Defence Evaluation and Research Agency`
		37	`(DERA). It is made available to Recipients with a`
		38	`royalty-free licence for its use, reproduction, transfer`
		39	`to other parties and amendment for any purpose not excluding`
		40	`product development provided that any such use et cetera`
		41	`shall be deemed to be acceptance of the following conditions:-`
6	7u83	42
2	7u83	43	`(1) Its Recipients shall ensure that this Notice is`
		44	`reproduced upon any copies or amended versions of it;`
6	7u83	45
2	7u83	46	`(2) Any amended version of it shall be clearly marked to`
		47	`show both the nature of and the organisation responsible`
		48	`for the relevant amendment or amendments;`
6	7u83	49
2	7u83	50	`(3) Its onward transfer from a recipient to another`
		51	`party shall be deemed to be that party's acceptance of`
		52	`these conditions;`
6	7u83	53
2	7u83	54	`(4) DERA gives no warranty or assurance as to its`
		55	`quality or suitability for any purpose and DERA accepts`
		56	`no liability whatsoever in relation to any use to which`
		57	`it may be put.`
		58	`*/`
		59
		60
		61	`#include "config.h"`
		62	`#include "calculus.h"`
		63	`#include "code.h"`
		64	`#include "error.h"`
		65	`#include "common.h"`
		66	`#include "lex.h"`
		67	`#include "output.h"`
		68	`#include "suffix.h"`
		69	`#include "type_ops.h"`
		70
		71
		72	`/*`
6	7u83	73	`* OUTPUT FLAGS`
		74	`*`
		75	`* The flag extra_asserts, if set to true, will cause the C implementation`
		76	`* of the output to include assertions for run-time checks. check_null is`
		77	`* a string used in the assertions output. extra_headers and map_proto`
		78	`* are used for backwards compatibility on extra headers and union map`
		79	`* prototypes.`
		80	`*/`
2	7u83	81
6	7u83	82	`int extra_asserts = 0;`
		83	`int extra_headers = 0;`
		84	`int map_proto = 1;`
		85	`static char *check_null;`
2	7u83	86
		87
		88	`/*`
6	7u83	89	`* PRINT AN ASSIGNMENT COMPONENT`
		90	`*`
		91	`* This routine prints the series of assignment operations to assign the`
		92	`* value of type t given by nm to an offset p from the variable x%u_. It`
		93	`* returns the offset from x%u_ at the end of these assignments.`
		94	`*/`
2	7u83	95
6	7u83	96	`static int`
		97	`assign_component(TYPE_P t, int p, char *nm, int depth)`
2	7u83	98	`{`
6	7u83	99	`TYPE t0 = DEREF_type(t);`
		100	`if (depth > MAX_TYPE_DEPTH) {`
		101	`error(ERROR_SERIOUS, "Cyclic type definition involving %s",`
		102	`name_type(t));`
		103	`return(p);`
2	7u83	104	`}`
		105
6	7u83	106	`if (IS_type_ident(t0)) {`
2	7u83	107	`/* Use identity definition */`
6	7u83	108	`IDENTITY_P id = DEREF_ptr(type_ident_id(t0));`
		109	`TYPE_P s = DEREF_ptr(ident_defn(id));`
		110	`return(assign_component(s, p, nm, depth + 1));`
2	7u83	111
6	7u83	112	`} else if (IS_type_structure(t0)) {`
2	7u83	113	`/* Deal with structures componentwise */`
6	7u83	114	`char buff[500];`
		115	`STRUCTURE_P str;`
		116	`LIST(COMPONENT_P)c;`
		117	`str = DEREF_ptr(type_structure_struc(t0));`
		118	`c = DEREF_list(str_defn(str));`
		119	`while (!IS_NULL_list(c)) {`
		120	`COMPONENT_P cmp = DEREF_ptr(HEAD_list(c));`
		121	`char *c_nm = DEREF_string(cmp_name(cmp));`
		122	`TYPE_P c_type = DEREF_ptr(cmp_type(cmp));`
		123	`int n = (int)strlen(nm) + (int)strlen(c_nm) + 8;`
		124	`if (n > (int)sizeof(buff)) {`
		125	`error(ERROR_SERIOUS, "Too many field selectors in type %s",`
		126	`name_type(t));`
		127	`break;`
2	7u83	128	`}`
6	7u83	129	`sprintf_v(buff, "%s.%s", nm, c_nm);`
		130	`p = assign_component(c_type, p, buff, depth + 1);`
		131	`c = TAIL_list(c);`
2	7u83	132	`}`
6	7u83	133	`return(p);`
2	7u83	134	`}`
		135
		136	`/* Other types are simple */`
6	7u83	137	`output("\tCOPY_%TM(x%u_ + %d, %e);\\\n", t, p, nm);`
		138	`return(p + size_type(t, 0));`
2	7u83	139	`}`
		140
		141
		142	`/*`
6	7u83	143	`* PRINT A DEREFERENCE COMPONENT`
		144	`*`
		145	`* This routine prints the series of dereference operations to assign the`
		146	`* value of type t given by an offset p from the variable x%u_ into nm. It`
		147	`* returns the offset from x%u_ at the end of these dereferences. depth is`
		148	`* used to catch cyclic type definitions.`
		149	`*/`
2	7u83	150
6	7u83	151	`static int`
		152	`deref_component(TYPE_P t, int p, char *nm, int depth)`
2	7u83	153	`{`
6	7u83	154	`TYPE t0 = DEREF_type(t);`
		155	`if (depth > MAX_TYPE_DEPTH) {`
		156	`error(ERROR_SERIOUS, "Cyclic type definition involving %s",`
		157	`name_type(t));`
		158	`return(p);`
2	7u83	159	`}`
		160
6	7u83	161	`if (IS_type_ident(t0)) {`
2	7u83	162	`/* Use identity definition */`
6	7u83	163	`IDENTITY_P id = DEREF_ptr(type_ident_id(t0));`
		164	`TYPE_P s = DEREF_ptr(ident_defn(id));`
		165	`return(deref_component(s, p, nm, depth + 1));`
2	7u83	166
6	7u83	167	`} else if (IS_type_structure(t0)) {`
2	7u83	168	`/* Deal with structures componentwise */`
6	7u83	169	`char buff[500];`
		170	`STRUCTURE_P str;`
		171	`LIST(COMPONENT_P)c;`
		172	`str = DEREF_ptr(type_structure_struc(t0));`
		173	`c = DEREF_list(str_defn(str));`
		174	`while (!IS_NULL_list(c)) {`
		175	`COMPONENT_P cmp = DEREF_ptr(HEAD_list(c));`
		176	`char *c_nm = DEREF_string(cmp_name(cmp));`
		177	`TYPE_P c_type = DEREF_ptr(cmp_type(cmp));`
		178	`int n = (int)strlen(nm) + (int)strlen(c_nm) + 8;`
		179	`if (n > (int)sizeof(buff)) {`
		180	`error(ERROR_SERIOUS, "Too many field selectors in type %s",`
		181	`name_type(t));`
		182	`break;`
2	7u83	183	`}`
6	7u83	184	`sprintf_v(buff, "%s.%s", nm, c_nm);`
		185	`p = deref_component(c_type, p, buff, depth + 1);`
		186	`c = TAIL_list(c);`
2	7u83	187	`}`
6	7u83	188	`return(p);`
2	7u83	189	`}`
		190
		191	`/* Other types are simple */`
6	7u83	192	`if (is_complex_type(t)) {`
		193	`output("\tDEREF_%TM(x%u_ + %d, %e);\\\n", t, p, nm);`
2	7u83	194	`} else {`
6	7u83	195	`output("\t%e = DEREF_%TM(x%u_ + %d);\\\n", nm, t, p);`
2	7u83	196	`}`
6	7u83	197	`return(p + size_type(t, 0));`
2	7u83	198	`}`
		199
		200
		201	`/*`
6	7u83	202	`* PRINT A DEREFERENCE INSTRUCTION`
		203	`*`
		204	`* This routine prints code to dereference an object of type t from a`
		205	`* into b.`
		206	`*/`
2	7u83	207
6	7u83	208	`void`
		209	`print_deref(TYPE_P t, char a, char b)`
2	7u83	210	`{`
6	7u83	211	`if (is_complex_type(t)) {`
		212	`output("DEREF_%TM(%e, %e);\n", t, a, b);`
2	7u83	213	`} else {`
6	7u83	214	`output("%e = DEREF_%TM(%e);\n", b, t, a);`
2	7u83	215	`}`
6	7u83	216	`return;`
2	7u83	217	`}`
		218
		219
		220	`/*`
6	7u83	221	`* PRINT PROTOTYPE MACROS`
		222	`*`
		223	`* This routine prints the prototype macros used by the output. The`
		224	`* default values correspond to the non-prototype case.`
		225	`*/`
2	7u83	226
6	7u83	227	`void`
		228	`print_proto(void)`
2	7u83	229	`{`
6	7u83	230	`comment("Prototype macros");`
		231	`output("#ifndef CONST_S\n");`
		232	`output("#define CONST_S\n");`
		233	`output("#endif\n\n\n");`
		234	`return;`
2	7u83	235	`}`
		236
		237
		238	`/*`
6	7u83	239	`* PRINT FILE INCLUSIONS`
		240	`*`
		241	`* This routine prints file inclusions for all the major output files.`
		242	`*/`
2	7u83	243
6	7u83	244	`void`
		245	`print_include(void)`
2	7u83	246	`{`
6	7u83	247	`output("#include \"%s%s\"\n", MAIN_PREFIX, MAIN_SUFFIX);`
		248	`LOOP_UNION output("#include \"%UM%s\"\n", OPS_SUFFIX);`
		249	`output("\n");`
		250	`return;`
2	7u83	251	`}`
		252
		253
		254	`/*`
6	7u83	255	`* PRINT RUNTIME ASSERTION MACROS`
		256	`*`
		257	`* These macros are used, if the extra_asserts variable is set, to make the`
		258	`* output code a little more readable. Moreover, if the checks need to`
		259	`* be turned off, then ASSERTS may be undefined.`
		260	`*/`
2	7u83	261
6	7u83	262	`static void`
		263	`print_assert_decs(void)`
2	7u83	264	`{`
6	7u83	265	`output("#ifdef ASSERTS\n");`
		266	`output("extern %X check_null_%X(%X , char *, int);\n");`
		267	`output("extern %X check_tag_%X(%X , unsigned, char *, int);\n");`
		268	`output("extern %X check_tag_etc_%X(%X , unsigned, unsigned, char *, int);\n");`
		269	`if (allow_vec) {`
		270	`output("extern int check_int_size(int, int, char *, int);\n");`
2	7u83	271	`}`
6	7u83	272	`output("#define CHECK_NULL(P)\\\n");`
		273	`output(" (check_null_%X((P), __FILE__, __LINE__))\n");`
		274	`output("#define CHECK_TAG(P, N)\\\n");`
		275	`output(" (check_tag_%X((P), (unsigned)(N), ");`
		276	`output("__FILE__, __LINE__))\n");`
		277	`output("#define CHECK_TAG_ETC(P, L, U)\\\n");`
		278	`output(" (check_tag_etc_%X((P), (unsigned)(L), ");`
		279	`output("(unsigned)(U), __FILE__, __LINE__))\n");`
		280	`if (allow_vec) {`
		281	`output("#define CHECK_INT(N, M)\\\n");`
		282	`output(" (check_int_size((N), (M), ");`
		283	`output("__FILE__, __LINE__))\n");`
2	7u83	284	`}`
6	7u83	285	`output("#else\n");`
		286	`output("#define CHECK_NULL(P)%t40(P)\n");`
		287	`output("#define CHECK_TAG(P, N)%t40(P)\n");`
		288	`output("#define CHECK_TAG_ETC(P, L, U)%t40(P)\n");`
		289	`if (allow_vec)output("#define CHECK_INT(N, M)%t40(N)\n");`
		290	`output("#endif\n\n\n");`
		291	`return;`
2	7u83	292	`}`
		293
		294
		295	`/*`
6	7u83	296	`* PRINT RUN-TIME CHECK FUNCTIONS`
		297	`*`
		298	`* If the assertion variable is set then these functions will be printed,`
		299	`* they are to be used to perform run-time checks on the calculus.`
		300	`* These functions are delivered to a special file.`
		301	`*/`
2	7u83	302
6	7u83	303	`static void`
		304	`print_assert_fns(void)`
2	7u83	305	`{`
		306	`/* Assertion printing */`
6	7u83	307	`output("#ifndef assert_%X\n");`
		308	`output("static void\n");`
		309	`output("assert_%X\n(char s, char fn, int ln)\n");`
		310	`output("{\n");`
		311	`output(" (void)fprintf(stderr, \"Assertion %%s failed, ");`
		312	`output("%%s, line %%d.\\n\", s, fn, ln);\n");`
		313	`output(" abort();\n");`
		314	`output("}\n");`
		315	`output("#endif\n\n");`
2	7u83	316
		317	`/* Null pointer check */`
6	7u83	318	`output("%X *\n");`
		319	`output("check_null_%X\n");`
		320	`output("(%X p, char fn, int ln)\n");`
		321	`output("{\n");`
		322	`output(" if (p == NULL) ");`
		323	`output("assert_%X(\"Null pointer\", fn, ln);\n");`
		324	`output(" return(p);\n");`
		325	`output("}\n\n");`
2	7u83	326
		327	`/* Union tag check */`
6	7u83	328	`output("%X *\n");`
		329	`output("check_tag_%X\n");`
		330	`output("(%X p, unsigned t, char fn, int ln)\n");`
		331	`output("{\n");`
		332	`output(" p = check_null_%X(p, fn, ln);\n");`
		333	`output(" if (p->ag_tag != t) ");`
		334	`output("assert_%X(\"Union tag\", fn, ln);\n");`
		335	`output(" return(p);\n");`
		336	`output("}\n\n");`
2	7u83	337
		338	`/* Union tag range check */`
6	7u83	339	`output("%X *\n");`
		340	`output("check_tag_etc_%X\n");`
		341	`output("(%X *p, unsigned tl, unsigned tb ");`
		342	`output("X char *fn X int ln)\n");`
		343	`output("{\n");`
		344	`output(" p = check_null_%X(p, fn, ln);\n");`
		345	`output(" if (p->ag_tag < tl \|\| p->ag_tag >= tb) {\n");`
		346	`output("\tassert_%X(\"Union tag\", fn, ln);\n");`
		347	`output(" }\n");`
		348	`output(" return(p);\n");`
		349	`output("}\n\n");`
2	7u83	350
		351	`/* Vector trim range check */`
6	7u83	352	`if (!allow_vec) return;`
		353	`output("int\n");`
		354	`output("check_int_size\n");`
		355	`output("(int n, int m, char *fn, int ln)\n");`
		356	`output("{\n");`
		357	`output(" if (n > m) assert_%X(\"Vector bound\", fn, ln);\n");`
		358	`output(" return(n);\n");`
		359	`output("}\n\n");`
		360	`return;`
2	7u83	361	`}`
		362
		363
		364	`/*`
6	7u83	365	`* MAXIMUM ALLOCATION CHUNK`
		366	`*`
		367	`* This variable is used to keep track of the largest block used in`
		368	`* the memory allocation routine.`
		369	`*/`
2	7u83	370
6	7u83	371	`static int gen_max = 0;`
2	7u83	372
		373
		374	`/*`
6	7u83	375	`* FIND A MEMORY ALLOCATION INSTRUCTION`
		376	`*`
		377	`* This routine returns the instruction for allocating a block of n`
		378	`* objects. gen_max is also kept up to date.`
		379	`*/`
2	7u83	380
6	7u83	381	`static char *`
		382	`gen(int n, char *nm)`
2	7u83	383	`{`
6	7u83	384	`static char gbuff[100];`
		385	`sprintf_v(gbuff, "GEN_%%X(%d, TYPEID_%s)", n, nm);`
		386	`if (n > gen_max)gen_max = n;`
		387	`return(gbuff);`
2	7u83	388	`}`
		389
		390
		391	`/*`
6	7u83	392	`* PRINT SIMPLE LIST CONSTRUCTORS`
		393	`*`
		394	`* This routine prints the list construction and deconstruction routines`
		395	`* for the type named nm of size sz. d is true for simply dereferenced`
		396	`* types.`
		397	`*/`
2	7u83	398
6	7u83	399	`static void`
		400	`print_simple_cons(char *nm, int sz, int d)`
2	7u83	401	`{`
		402	`/* CONS routine */`
6	7u83	403	`char *g;`
		404	`output("#define CONS_%e(A, B, C)\\\n", nm);`
		405	`output(" {\\\n");`
		406	`g = gen(sz + 1, "list");`
		407	`output("\t%X *x%u_ = %e;\\\n", g);`
		408	`output("\tCOPY_%e(x%u_ + 1, (A));\\\n", nm);`
		409	`output("\tx%u_->ag_ptr = (B);\\\n");`
		410	`output("\t(C) = x%u_;\\\n");`
		411	`output(" }\n\n");`
		412	`unique++;`
2	7u83	413
		414	`/* UN_CONS routine */`
6	7u83	415	`output("#define UN_CONS_%e(A, B, C)\\\n", nm);`
		416	`output(" {\\\n");`
		417	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		418	`if (d) {`
		419	`output("\t(A) = DEREF_%e(x%u_ + 1);\\\n", nm);`
2	7u83	420	`} else {`
6	7u83	421	`output("\tDEREF_%e(x%u_ + 1, (A));\\\n", nm);`
2	7u83	422	`}`
6	7u83	423	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		424	`output(" }\n\n");`
		425	`unique++;`
2	7u83	426
		427	`/* DESTROY_CONS routine */`
6	7u83	428	`output("#define DESTROY_CONS_%e(D, A, B, C)\\\n", nm);`
		429	`output(" {\\\n");`
		430	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		431	`if (d) {`
		432	`output("\t(A) = DEREF_%e(x%u_ + 1);\\\n", nm);`
2	7u83	433	`} else {`
6	7u83	434	`output("\tDEREF_%e(x%u_ + 1, (A));\\\n", nm);`
2	7u83	435	`}`
6	7u83	436	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		437	`output("\t(D)(x%u_, (unsigned)%d);\\\n", sz + 1);`
		438	`output(" }\n\n");`
		439	`unique++;`
2	7u83	440
6	7u83	441	`if (allow_stack) {`
2	7u83	442	`/* PUSH routine */`
6	7u83	443	`output("#define PUSH_%e(A, B)\\\n", nm);`
		444	`output(" {\\\n");`
		445	`output("\t%X **r%u_ = &(B);\\\n");`
		446	`g = gen(sz + 1, "stack");`
		447	`output("\t%X *x%u_ = %e;\\\n", g);`
		448	`output("\tCOPY_%e(x%u_ + 1, (A));\\\n", nm);`
		449	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		450	`output("\t*r%u_ = x%u_;\\\n");`
		451	`output(" }\n\n");`
		452	`unique++;`
2	7u83	453
		454	`/* POP routine */`
6	7u83	455	`output("#define POP_%e(A, B)\\\n", nm);`
		456	`output(" {\\\n");`
		457	`output("\t%X **r%u_ = &(B);\\\n");`
		458	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		459	`if (d) {`
		460	`output("\t(A) = DEREF_%e(x%u_ + 1);\\\n", nm);`
2	7u83	461	`} else {`
6	7u83	462	`output("\tDEREF_%e(x%u_ + 1, (A));\\\n", nm);`
2	7u83	463	`}`
6	7u83	464	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		465	`output("\tdestroy_%X(x%u_, (unsigned)%d);\\\n", sz + 1);`
		466	`output(" }\n\n");`
		467	`unique++;`
2	7u83	468	`}`
		469
		470	`/* End of routine */`
6	7u83	471	`output("\n");`
		472	`return;`
2	7u83	473	`}`
		474
		475
		476	`/*`
6	7u83	477	`* PRINT STRUCTURE DEFINITIONS`
		478	`*`
		479	`* This routine prints all the structure declarations and definitions`
		480	`* and all identity declarations. Some care needs to be taken with the`
		481	`* ordering of the structure definitions. Cyclic structures will have`
		482	`* already been detected, so there is no need to worry about them.`
		483	`*/`
2	7u83	484
6	7u83	485	`void`
		486	`print_struct_defn(void)`
2	7u83	487	`{`
6	7u83	488	`int ok;`
		489	`comment("Structure declarations");`
2	7u83	490	`LOOP_STRUCTURE {`
6	7u83	491	`output("typedef struct %SM_tag %SN;\n");`
		492	`COPY_int(str_output(CRT_STRUCTURE), 0);`
2	7u83	493	`}`
6	7u83	494	`output("\n\n");`
2	7u83	495
6	7u83	496	`comment("Identity type definitions");`
		497	`LOOP_IDENTITY output("typedef %IT %IN;\n");`
		498	`output("\n\n");`
2	7u83	499
6	7u83	500	`comment("Structure definitions");`
		501	`output("#ifndef %X_STRUCT_DEFINED\n");`
		502	`output("#define %X_STRUCT_DEFINED\n\n");`
2	7u83	503	`do {`
6	7u83	504	`ok = 1;`
2	7u83	505	`LOOP_STRUCTURE {`
6	7u83	506	`int pr = DEREF_int(str_output(CRT_STRUCTURE));`
		507	`if (pr == 0) {`
2	7u83	508	`/* Check if all components have been printed */`
6	7u83	509	`pr = 1;`
2	7u83	510	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	511	`TYPE t0;`
		512	`TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		513	`t0 = DEREF_type(t);`
		514	`while (IS_type_ident(t0)) {`
		515	`IDENTITY_P id;`
		516	`id = DEREF_ptr(type_ident_id(t0));`
		517	`t = DEREF_ptr(ident_defn(id));`
		518	`t0 = DEREF_type(t);`
2	7u83	519	`}`
6	7u83	520	`if (IS_type_structure(t0)) {`
		521	`STRUCTURE_P str;`
		522	`str = DEREF_ptr(type_structure_struc(t0));`
		523	`pr = DEREF_int(str_output(str));`
		524	`if (pr == 0) {`
		525	`break;`
		526	`}`
2	7u83	527	`}`
		528	`}`
6	7u83	529	`if (pr) {`
2	7u83	530	`/* Print structure definition */`
6	7u83	531	`output("struct %SM_tag {\n");`
		532	`LOOP_STRUCTURE_COMPONENT output(" %CT %CN;\n");`
		533	`output("};\n\n");`
		534	`COPY_int(str_output(CRT_STRUCTURE), 1);`
2	7u83	535	`} else {`
		536	`/* Structure definition postponed */`
6	7u83	537	`output("/* struct %SM_tag later */\n\n");`
		538	`ok = 0;`
2	7u83	539	`}`
		540	`}`
		541	`}`
6	7u83	542	`} while (!ok);`
		543	`output("#endif /* %X_STRUCT_DEFINED */\n\n\n");`
		544	`return;`
2	7u83	545	`}`
		546
		547
		548	`/*`
6	7u83	549	`* PRINT BASIC TYPES (C VERSION)`
		550	`*`
		551	`* This routine prints the C versions of the basic type definitions.`
		552	`*/`
2	7u83	553
6	7u83	554	`static void`
		555	`print_types_c(void)`
2	7u83	556	`{`
6	7u83	557	`int n;`
		558	`comment("Primitive types");`
2	7u83	559	`LOOP_PRIMITIVE {`
6	7u83	560	`CLASS_ID_P c = DEREF_ptr(prim_id(CRT_PRIMITIVE));`
		561	`char *pn = DEREF_string(cid_name(c));`
		562	`char *pd = DEREF_string(prim_defn(CRT_PRIMITIVE));`
		563	`if (!streq(pn, pd)) {`
		564	`output("typedef %PD %PN;\n");`
		565	`}`
2	7u83	566	`}`
6	7u83	567	`output("\n\n");`
2	7u83	568
6	7u83	569	`comment("Basic types");`
		570	`if (allow_vec) {`
		571	`output("typedef unsigned %X_dim;\n\n");`
		572	`}`
		573	`output("typedef union %X_tag {\n");`
		574	`output(" unsigned ag_tag;\n");`
		575	`output(" union %X_tag *ag_ptr;\n");`
		576	`if (allow_vec) {`
		577	`output(" %X_dim ag_dim;\n");`
		578	`}`
		579	`output(" unsigned ag_enum;\n");`
		580	`output(" unsigned long ag_long_enum;\n");`
		581	`LOOP_PRIMITIVE output(" %PN ag_prim_%PM;\n");`
		582	`output("} %X;\n\n");`
		583	`output("typedef %X *%X_PTR;\n\n");`
2	7u83	584
6	7u83	585	`if (allow_vec) {`
		586	`output("typedef struct {\n");`
		587	`output(" %X *vec;\n");`
		588	`output(" %X *ptr;\n");`
		589	`output("} %X_VEC_PTR;\n\n");`
2	7u83	590
6	7u83	591	`output("typedef struct {\n");`
		592	`output(" %X_dim dim;\n");`
		593	`output(" %X_VEC_PTR elems;\n");`
		594	`output("} %X_VEC;\n\n");`
2	7u83	595	`}`
		596
6	7u83	597	`output("#ifndef %X_DESTR_DEFINED\n");`
		598	`output("#define %X_DESTR_DEFINED\n");`
		599	`output("typedef void (*DESTROYER)");`
		600	`output("(%X *, unsigned);\n");`
		601	`output("#endif\n\n");`
2	7u83	602
6	7u83	603	`output("#define PTR(A)\t%X_PTR\n");`
		604	`output("#define LIST(A)\t%X_PTR\n");`
		605	`if (allow_stack) {`
		606	`output("#define STACK(A)\t%X_PTR\n");`
2	7u83	607	`}`
6	7u83	608	`if (allow_vec) {`
		609	`output("#define VEC(A)\t%X_VEC\n");`
		610	`output("#define VEC_PTR(A)\t%X_VEC_PTR\n");`
2	7u83	611	`}`
6	7u83	612	`output("#define SIZE(A)\tint\n\n\n");`
2	7u83	613
6	7u83	614	`if (extra_asserts) {`
		615	`comment("Assertion macros");`
		616	`print_assert_decs();`
2	7u83	617	`}`
		618
6	7u83	619	`comment("Enumeration definitions");`
2	7u83	620	`LOOP_ENUM {`
6	7u83	621	`number m = DEREF_number(en_order(CRT_ENUM));`
		622	`if (m > (number)0x10000) {`
		623	`output("typedef unsigned long %EN;\n");`
2	7u83	624	`} else {`
6	7u83	625	`output("typedef unsigned %EN;\n");`
2	7u83	626	`}`
		627	`}`
6	7u83	628	`output("\n\n");`
2	7u83	629
6	7u83	630	`comment("Union type definitions");`
		631	`LOOP_UNION output("typedef %X *%UN;\n");`
		632	`output("\n\n");`
2	7u83	633
6	7u83	634	`print_struct_defn();`
2	7u83	635
6	7u83	636	`comment("Function declarations");`
		637	`output("extern %X *gen_%X(unsigned);\n");`
		638	`output("extern void destroy_%X(%X *, unsigned);\n");`
		639	`output("extern void dummy_destroy_%X ");`
		640	`output("(%X *, unsigned);\n");`
		641	`output("extern void destroy_%X_list ");`
		642	`output("(%X *, unsigned);\n");`
		643	`output("extern %X append_%X_list(%X , %X *);\n");`
		644	`output("extern %X end_%X_list(%X );\n");`
		645	`output("extern unsigned length_%X_list(%X *);\n");`
		646	`output("extern %X reverse_%X_list(%X );\n");`
		647	`if (allow_vec) {`
		648	`output("extern %X_VEC empty_%X_vec;\n");`
		649	`}`
		650	`output("#ifdef %X_IO_ROUTINES\n");`
		651	`output("extern unsigned crt_%X_alias;\n");`
		652	`output("extern void set_%X_alias(%X *, unsigned);\n");`
		653	`output("extern %X *find_%X_alias(unsigned);\n");`
		654	`output("extern void clear_%X_alias(void);\n");`
		655	`output("#endif\n");`
		656	`output("\n\n");`
		657	`comment("Run-time type information");`
		658	`output("#ifndef GEN_%X\n");`
		659	`output("#define GEN_%X(A, B)%t40gen_%X((unsigned)(A))\n");`
		660	`output("#endif\n");`
		661	`output("#define TYPEID_ptr%t40((unsigned)0)\n");`
		662	`output("#define TYPEID_list%t40((unsigned)1)\n");`
		663	`output("#define TYPEID_stack%t40((unsigned)2)\n");`
		664	`n = 3;`
2	7u83	665	`LOOP_UNION {`
6	7u83	666	`output("#define TYPEID_%UM%t40((unsigned)%d)\n", n);`
		667	`n++;`
2	7u83	668	`}`
6	7u83	669	`output("\n\n");`
		670	`return;`
2	7u83	671	`}`
		672
		673
		674	`/*`
6	7u83	675	`* PRINT POINTER CONSTRUCTS (C VERSION)`
		676	`*`
		677	`* This routine prints the C versions of the pointer constructs.`
		678	`*/`
2	7u83	679
6	7u83	680	`static void`
		681	`print_ptr_c(void)`
2	7u83	682	`{`
		683	`/* Pointers */`
6	7u83	684	`char *g;`
		685	`comment("Definitions for pointers");`
		686	`output("#define STEP_ptr(A, B)%t40");`
		687	`output("(%s(A) + B)\n", check_null);`
		688	`output("#define SIZE_ptr(A)%t40%d\n", SIZE_PTR);`
		689	`output("#define NULL_ptr(A)%t40((%X *)0)\n");`
		690	`output("#define IS_NULL_ptr(A)%t40((A) == 0)\n");`
		691	`output("#define EQ_ptr(A, B)%t40((A) == (B))\n");`
		692	`output("#define MAKE_ptr(A)%t40GEN_%X((A), TYPEID_ptr)\n");`
		693	`output("#define DESTROY_ptr(A, B)%t40");`
		694	`output("destroy_%X((A), (unsigned)(B))\n");`
		695	`g = gen(1, "ptr");`
		696	`output("#define UNIQ_ptr(A)%t40%e\n", g);`
		697	`output("#define DESTROY_UNIQ_ptr(A)%t40");`
		698	`output("destroy_%X((A), (unsigned)1)\n");`
		699	`output("#ifdef %X_IO_ROUTINES\n");`
		700	`output("#define VOIDSTAR_ptr(A)%t40((void *)(A))\n");`
		701	`output("#endif\n\n");`
2	7u83	702
		703	`/* Assignment and dereference of pointers */`
6	7u83	704	`output("#define COPY_ptr(A, B)%t40");`
		705	`output("(%s(A)->ag_ptr = (B))\n", check_null);`
		706	`output("#define DEREF_ptr(A)%t40");`
		707	`output("(%s(A)->ag_ptr)\n", check_null);`
2	7u83	708
		709	`/* Pointer list constructor */`
6	7u83	710	`output("#define CONS_ptr(A, B, C)\\\n");`
		711	`output(" {\\\n");`
		712	`g = gen(SIZE_PTR + 1, "list");`
		713	`output("\t%X *x%u_ = %e;\\\n", g);`
		714	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		715	`output("\tx%u_->ag_ptr = (B);\\\n");`
		716	`output("\t(C) = x%u_;\\\n");`
		717	`output(" }\n\n");`
		718	`unique++;`
2	7u83	719
		720	`/* Pointer list deconstructor */`
6	7u83	721	`output("#define UN_CONS_ptr(A, B, C)\\\n");`
		722	`output(" {\\\n");`
		723	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		724	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		725	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		726	`output(" }\n\n");`
		727	`unique++;`
2	7u83	728
		729	`/* Pointer list destructor */`
6	7u83	730	`output("#define DESTROY_CONS_ptr(D, A, B, C)\\\n");`
		731	`output(" {\\\n");`
		732	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		733	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		734	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		735	`output("\t(D)(x%u_, (unsigned)2);\\\n");`
		736	`output(" }\n\n");`
		737	`unique++;`
2	7u83	738
6	7u83	739	`if (allow_stack) {`
2	7u83	740	`/* Pointer stack constructor */`
6	7u83	741	`output("#define PUSH_ptr(A, B)\\\n");`
		742	`output(" {\\\n");`
		743	`output("\t%X **r%u_ = &(B);\\\n");`
		744	`g = gen(SIZE_PTR + 1, "stack");`
		745	`output("\t%X *x%u_ = %e;\\\n", g);`
		746	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		747	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		748	`output("\t*r%u_ = x%u_;\\\n");`
		749	`output(" }\n\n");`
		750	`unique++;`
2	7u83	751
		752	`/* Pointer stack destructor */`
6	7u83	753	`output("#define POP_ptr(A, B)\\\n");`
		754	`output(" {\\\n");`
		755	`output("\t%X **r%u_ = &(B);\\\n");`
		756	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		757	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		758	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		759	`output("\tdestroy_%X(x%u_, (unsigned)2);\\\n");`
		760	`output(" }\n\n");`
		761	`unique++;`
2	7u83	762	`}`
		763
6	7u83	764	`output("\n");`
		765	`return;`
2	7u83	766	`}`
		767
		768
		769	`/*`
6	7u83	770	`* PRINT LIST CONSTRUCTS (C VERSION)`
		771	`*`
		772	`* This routine prints the C versions of the list constructs.`
		773	`*/`
2	7u83	774
6	7u83	775	`static void`
		776	`print_list_c(void)`
2	7u83	777	`{`
		778	`/* Lists */`
6	7u83	779	`char *g;`
		780	`comment("Definitions for lists");`
		781	`output("#define HEAD_list(A)%t40");`
		782	`output("(%s(A) + 1)\n", check_null);`
		783	`output("#define PTR_TAIL_list(A)%t40");`
		784	`output("(%s(A))\n", check_null);`
		785	`output("#define TAIL_list(A)%t40");`
		786	`output("(%s(A)->ag_ptr)\n", check_null);`
2	7u83	787
6	7u83	788	`output("#define LENGTH_list(A)%t40length_%X_list((A))\n");`
		789	`output("#define END_list(A)%t40end_%X_list((A))\n");`
		790	`output("#define REVERSE_list(A)%t40reverse_%X_list((A))\n");`
		791	`output("#define APPEND_list(A, B)%t40");`
		792	`output("append_%X_list((A), (B))\n\n");`
		793	`output("#define SIZE_list(A)%t40%d\n", SIZE_LIST);`
		794	`output("#define NULL_list(A)%t40((%X *) 0)\n");`
		795	`output("#define IS_NULL_list(A)%t40((A) == 0)\n");`
		796	`output("#define EQ_list(A, B)%t40((A) == (B))\n");`
		797	`g = gen(1, "list");`
		798	`output("#define UNIQ_list(A)%t40%e\n", g);`
		799	`output("#define DESTROY_UNIQ_list(A)%t40");`
		800	`output("destroy_%X((A), (unsigned)1)\n");`
		801	`output("#ifdef %X_IO_ROUTINES\n");`
		802	`output("#define VOIDSTAR_list(A)%t40((void *)(A))\n");`
		803	`output("#endif\n\n");`
2	7u83	804
		805	`/* Destruction of lists */`
6	7u83	806	`output("#define DESTROY_list(A, B)\\\n");`
		807	`output(" {\\\n");`
		808	`output("\tdestroy_%X_list((A), (unsigned)(B));\\\n");`
		809	`output(" }\n\n");`
2	7u83	810
		811	`/* Assignment and dereference of lists */`
6	7u83	812	`output("#define COPY_list(A, B)%t40");`
		813	`output("(%s(A)->ag_ptr = (B))\n", check_null);`
		814	`output("#define DEREF_list(A)%t40");`
		815	`output("(%s(A)->ag_ptr)\n", check_null);`
2	7u83	816
		817	`/* List list constructor */`
6	7u83	818	`output("#define CONS_list(A, B, C)\\\n");`
		819	`output(" {\\\n");`
		820	`g = gen(SIZE_LIST + 1, "list");`
		821	`output("\t%X *x%u_ = %e;\\\n", g);`
		822	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		823	`output("\tx%u_->ag_ptr = (B);\\\n");`
		824	`output("\t(C) = x%u_;\\\n");`
		825	`output(" }\n\n");`
		826	`unique++;`
2	7u83	827
		828	`/* List list deconstructor */`
6	7u83	829	`output("#define UN_CONS_list(A, B, C)\\\n");`
		830	`output(" {\\\n");`
		831	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		832	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		833	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		834	`output(" }\n\n");`
		835	`unique++;`
2	7u83	836
		837	`/* List list destructor */`
6	7u83	838	`output("#define DESTROY_CONS_list(D, A, B, C)\\\n");`
		839	`output(" {\\\n");`
		840	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		841	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		842	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		843	`output("\t(D)(x%u_, (unsigned)2);\\\n");`
		844	`output(" }\n\n");`
		845	`unique++;`
2	7u83	846
6	7u83	847	`if (allow_stack) {`
2	7u83	848	`/* List stack constructor */`
6	7u83	849	`output("#define PUSH_list(A, B)\\\n");`
		850	`output(" {\\\n");`
		851	`output("\t%X **r%u_ = &(B);\\\n");`
		852	`g = gen(SIZE_LIST + 1, "stack");`
		853	`output("\t%X *x%u_ = %e;\\\n", g);`
		854	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		855	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		856	`output("\t*r%u_ = x%u_;\\\n");`
		857	`output(" }\n\n");`
		858	`unique++;`
2	7u83	859
		860	`/* List stack destructor */`
6	7u83	861	`output("#define POP_list(A, B)\\\n");`
		862	`output(" {\\\n");`
		863	`output("\t%X **r%u_ = &(B);\\\n");`
		864	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		865	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		866	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		867	`output("\tdestroy_%X(x%u_, (unsigned)2);\\\n");`
		868	`output(" }\n\n");`
		869	`unique++;`
2	7u83	870	`}`
		871
6	7u83	872	`output("\n");`
		873	`return;`
2	7u83	874	`}`
		875
		876
		877	`/*`
6	7u83	878	`* PRINT STACK CONSTRUCTS (C VERSION)`
		879	`*`
		880	`* This routine prints the C versions of the stack constructs.`
		881	`*/`
2	7u83	882
6	7u83	883	`static void`
		884	`print_stack_c(void)`
2	7u83	885	`{`
		886	`/* Stacks */`
6	7u83	887	`char *g;`
		888	`comment("Definitions for stacks");`
		889	`output("#define SIZE_stack(A)%t40%d\n", SIZE_STACK);`
		890	`output("#define NULL_stack(A)%t40((%X *) 0)\n");`
		891	`output("#define IS_NULL_stack(A)%t40((A) == 0)\n");`
		892	`output("#define STACK_list(A)%t40(A)\n");`
		893	`output("#define LIST_stack(A)%t40(A)\n\n");`
2	7u83	894
		895	`/* Assignment and dereference of stacks */`
6	7u83	896	`output("#define COPY_stack(A, B)%t40");`
		897	`output("(%s(A)->ag_ptr = (B))\n", check_null);`
		898	`output("#define DEREF_stack(A)%t40");`
		899	`output("(%s(A)->ag_ptr)\n", check_null);`
2	7u83	900
		901	`/* Stack list constructor */`
6	7u83	902	`output("#define CONS_stack(A, B, C)\\\n");`
		903	`output(" {\\\n");`
		904	`g = gen(SIZE_STACK + 1, "list");`
		905	`output("\t%X *x%u_ = %e;\\\n", g);`
		906	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		907	`output("\tx%u_->ag_ptr = (B);\\\n");`
		908	`output("\t(C) = x%u_;\\\n");`
		909	`output(" }\n\n");`
		910	`unique++;`
2	7u83	911
		912	`/* Stack list deconstructor */`
6	7u83	913	`output("#define UN_CONS_stack(A, B, C)\\\n");`
		914	`output(" {\\\n");`
		915	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		916	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		917	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		918	`output(" }\n\n");`
		919	`unique++;`
2	7u83	920
		921	`/* Stack list destructor */`
6	7u83	922	`output("#define DESTROY_CONS_stack(D, A, B, C)\\\n");`
		923	`output(" {\\\n");`
		924	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		925	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		926	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		927	`output("\t(D)(x%u_, (unsigned)2);\\\n");`
		928	`output(" }\n\n");`
		929	`unique++;`
2	7u83	930
6	7u83	931	`if (allow_stack) {`
2	7u83	932	`/* Stack stack constructor */`
6	7u83	933	`output("#define PUSH_stack(A, B)\\\n");`
		934	`output(" {\\\n");`
		935	`output("\t%X **r%u_ = &(B);\\\n");`
		936	`g = gen(SIZE_STACK + 1, "stack");`
		937	`output("\t%X *x%u_ = %e;\\\n", g);`
		938	`output("\tx%u_[1].ag_ptr = (A);\\\n");`
		939	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		940	`output("\t*r%u_ = x%u_;\\\n");`
		941	`output(" }\n\n");`
		942	`unique++;`
2	7u83	943
		944	`/* Stack stack destructor */`
6	7u83	945	`output("#define POP_stack(A, B)\\\n");`
		946	`output(" {\\\n");`
		947	`output("\t%X **r%u_ = &(B);\\\n");`
		948	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		949	`output("\t(A) = x%u_[1].ag_ptr;\\\n");`
		950	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		951	`output("\tdestroy_%X(x%u_, (unsigned)2);\\\n");`
		952	`output(" }\n\n");`
		953	`unique++;`
2	7u83	954	`}`
		955
6	7u83	956	`output("\n");`
		957	`return;`
2	7u83	958	`}`
		959
		960
		961	`/*`
6	7u83	962	`* PRINT VECTOR CONSTRUCTS (C VERSION)`
		963	`*`
		964	`* This routine prints the C versions of the vector constructs.`
		965	`*/`
2	7u83	966
6	7u83	967	`static void`
		968	`print_vec_c(void)`
2	7u83	969	`{`
		970	`/* Vectors */`
6	7u83	971	`char *g;`
		972	`comment("Definitions for vectors");`
		973	`output("#define DIM_vec(A)%t40((A).dim)\n");`
		974	`output("#define PTR_ptr_vec(A)%t40");`
		975	`output("(%s(A)[2].ag_ptr)\n", check_null);`
		976	`output("#define DIM_ptr_vec(A)%t40((A)->ag_dim)\n");`
		977	`output("#define SIZE_vec(A)%t40%d\n", SIZE_VEC);`
		978	`output("#define NULL_vec(A)%t40empty_%X_vec\n\n");`
2	7u83	979
		980	`/* Vector creation */`
6	7u83	981	`output("#define MAKE_vec(SZ, U, RES)\\\n");`
		982	`output(" {\\\n");`
		983	`output("\t%X_VEC x%u_;\\\n");`
		984	`output("\t%X_dim u%u_ = (U);\\\n");`
		985	`output("\tx%u_.dim = u%u_;\\\n");`
		986	`output("\tif (u%u_ == 0) u%u_ = 1;\\\n");`
		987	`output("\tx%u_.elems.ptr = ");`
		988	`output("GEN_%X((SZ)*u%u_, TYPEID_ptr);\\\n");`
		989	`output("\tx%u_.elems.vec = x%u_.elems.ptr;\\\n");`
		990	`output("\t(RES) = x%u_;\\\n");`
		991	`output(" }\n\n");`
		992	`unique++;`
2	7u83	993
		994	`/* Vector destroyer */`
6	7u83	995	`output("#define DESTROY_vec(V, SZ)\\\n");`
		996	`output(" {\\\n");`
		997	`output("\t%X_VEC x%u_;\\\n");`
		998	`output("\tx%u_ = (V);\\\n");`
		999	`output("\tdestroy_%X (x%u_.elems.ptr, ");`
		1000	`output("(unsigned)((SZ)*x%u_.dim));\\\n");`
		1001	`output(" }\n\n");`
		1002	`unique++;`
2	7u83	1003
		1004	`/* Vector trimmer */`
6	7u83	1005	`output("#define TRIM_vec(V, SZ, L, U, RES)\\\n");`
		1006	`output(" {\\\n");`
		1007	`output("\t%X_VEC x%u_;\\\n");`
		1008	`if (extra_asserts) {`
		1009	`output("\tint u%u_, l%u_;\\\n");`
		1010	`output("\tx%u_ = (V);\\\n");`
		1011	`output("\tu%u_ = CHECK_INT ((U), DIM_vec(x%u_));\\\n");`
		1012	`output("\tl%u_ = CHECK_INT ((L), u%u_);\\\n");`
		1013	`output("\tx%u_.elems.ptr += ((SZ)*l%u_);\\\n");`
		1014	`output("\tx%u_.dim = (unsigned)(u%u_ - l%u_);\\\n");`
2	7u83	1015	`} else {`
6	7u83	1016	`output("\tint l%u_ = (L);\\\n");`
		1017	`output("\tx%u_ = (V);\\\n");`
		1018	`output("\tx%u_.elems.ptr += ((SZ)*l%u_);\\\n");`
		1019	`output("\tx%u_.dim = (unsigned)((U) - l%u_);\\\n");`
2	7u83	1020	`}`
6	7u83	1021	`output("\t(RES) = x%u_;\\\n");`
		1022	`output(" }\n\n");`
		1023	`unique++;`
2	7u83	1024
		1025	`/* Vector assignment */`
6	7u83	1026	`output("#define COPY_vec(A, B)\\\n");`
		1027	`output(" {\\\n");`
		1028	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1029	`output("\t%X_VEC y%u_;\\\n");`
		1030	`output("\ty%u_ = (B);\\\n");`
		1031	`output("\tx%u_[0].ag_dim = y%u_.dim;\\\n");`
		1032	`output("\tx%u_[1].ag_ptr = y%u_.elems.vec;\\\n");`
		1033	`output("\tx%u_[2].ag_ptr = y%u_.elems.ptr;\\\n");`
		1034	`output(" }\n\n");`
		1035	`unique++;`
2	7u83	1036
		1037	`/* Vector dereference */`
6	7u83	1038	`output("#define DEREF_vec(A, B)\\\n");`
		1039	`output(" {\\\n");`
		1040	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1041	`output("\t%X_VEC *y%u_ = &(B);\\\n");`
		1042	`output("\ty%u_->dim = x%u_[0].ag_dim;\\\n");`
		1043	`output("\ty%u_->elems.vec = x%u_[1].ag_ptr;\\\n");`
		1044	`output("\ty%u_->elems.ptr = x%u_[2].ag_ptr;\\\n");`
		1045	`output(" }\n\n");`
		1046	`unique++;`
2	7u83	1047
		1048	`/* Vector list constructor */`
6	7u83	1049	`output("#define CONS_vec(A, B, C)\\\n");`
		1050	`output(" {\\\n");`
		1051	`g = gen(SIZE_VEC + 1, "list");`
		1052	`output("\t%X *x%u_ = %e;\\\n", g);`
		1053	`output("\t%X_VEC y%u_;\\\n");`
		1054	`output("\ty%u_ = (A);\\\n");`
		1055	`output("\tx%u_[1].ag_dim = y%u_.dim;\\\n");`
		1056	`output("\tx%u_[2].ag_ptr = y%u_.elems.vec;\\\n");`
		1057	`output("\tx%u_[3].ag_ptr = y%u_.elems.ptr;\\\n");`
		1058	`output("\tx%u_->ag_ptr = (B);\\\n");`
		1059	`output("\t(C) = x%u_;\\\n");`
		1060	`output(" }\n\n");`
		1061	`unique++;`
2	7u83	1062
		1063	`/* Vector list deconstructor */`
6	7u83	1064	`output("#define UN_CONS_vec(A, B, C)\\\n");`
		1065	`output(" {\\\n");`
		1066	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		1067	`output("\t%X_VEC *y%u_ = &(A);\\\n");`
		1068	`output("\ty%u_->dim = x%u_[1].ag_dim;\\\n");`
		1069	`output("\ty%u_->elems.vec = x%u_[2].ag_ptr;\\\n");`
		1070	`output("\ty%u_->elems.ptr = x%u_[3].ag_ptr;\\\n");`
		1071	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		1072	`output(" }\n\n");`
		1073	`unique++;`
2	7u83	1074
		1075	`/* Vector list destructor */`
6	7u83	1076	`output("#define DESTROY_CONS_vec(D, A, B, C)\\\n");`
		1077	`output(" {\\\n");`
		1078	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		1079	`output("\t%X_VEC *y%u_ = &(A);\\\n");`
		1080	`output("\ty%u_->dim = x%u_[1].ag_dim;\\\n");`
		1081	`output("\ty%u_->elems.vec = x%u_[2].ag_ptr;\\\n");`
		1082	`output("\ty%u_->elems.ptr = x%u_[3].ag_ptr;\\\n");`
		1083	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		1084	`output("\t(D)(x%u_, (unsigned)4);\\\n");`
		1085	`output(" }\n\n");`
		1086	`unique++;`
2	7u83	1087
6	7u83	1088	`if (allow_stack) {`
2	7u83	1089	`/* Vector stack constructor */`
6	7u83	1090	`output("#define PUSH_vec(A, B)\\\n");`
		1091	`output(" {\\\n");`
		1092	`output("\t%X **r%u_ = &(B);\\\n");`
		1093	`g = gen(SIZE_VEC + 1, "stack");`
		1094	`output("\t%X *x%u_ = %e;\\\n", g);`
		1095	`output("\t%X_VEC y%u_;\\\n");`
		1096	`output("\ty%u_ = (A);\\\n");`
		1097	`output("\tx%u_[1].ag_dim = y%u_.dim;\\\n");`
		1098	`output("\tx%u_[2].ag_ptr = y%u_.elems.vec;\\\n");`
		1099	`output("\tx%u_[3].ag_ptr = y%u_.elems.ptr;\\\n");`
		1100	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		1101	`output("\t*r%u_ = x%u_;\\\n");`
		1102	`output(" }\n\n");`
		1103	`unique++;`
2	7u83	1104
		1105	`/* Vector stack destructor */`
6	7u83	1106	`output("#define POP_vec(A, B)\\\n");`
		1107	`output(" {\\\n");`
		1108	`output("\t%X **r%u_ = &(B);\\\n");`
		1109	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		1110	`output("\t%X_VEC *y%u_ = &(A);\\\n");`
		1111	`output("\ty%u_->dim = x%u_[1].ag_dim;\\\n");`
		1112	`output("\ty%u_->elems.vec = x%u_[2].ag_ptr;\\\n");`
		1113	`output("\ty%u_->elems.ptr = x%u_[3].ag_ptr;\\\n");`
		1114	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		1115	`output("\tdestroy_%X(x%u_, (unsigned)4);\\\n");`
		1116	`output(" }\n\n");`
		1117	`unique++;`
2	7u83	1118	`}`
		1119
6	7u83	1120	`output("\n");`
		1121	`return;`
2	7u83	1122	`}`
		1123
		1124
		1125	`/*`
6	7u83	1126	`* PRINT VECTOR POINTER CONSTRUCTS (C VERSION)`
		1127	`*`
		1128	`* This routine prints the C versions of the vector pointer constructs.`
		1129	`*/`
2	7u83	1130
6	7u83	1131	`static void`
		1132	`print_vec_ptr_c(void)`
2	7u83	1133	`{`
		1134	`/* Vector pointers */`
6	7u83	1135	`char *g;`
		1136	`comment("Definitions for vector pointers");`
		1137	`output("#define VEC_PTR_vec(A)%t40((A).elems)\n");`
		1138	`output("#define PTR_vec_ptr(A)%t40((A).ptr)\n");`
		1139	`output("#define SIZE_vec_ptr(A)%t40%d\n\n", SIZE_VEC_PTR);`
2	7u83	1140
		1141	`/* Vector pointer assignment */`
6	7u83	1142	`output("#define COPY_vec_ptr(A, B)\\\n");`
		1143	`output(" {\\\n");`
		1144	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1145	`output("\t%X_VEC_PTR y%u_;\\\n");`
		1146	`output("\ty%u_ = (B);\\\n");`
		1147	`output("\tx%u_->ag_ptr = y%u_.vec;\\\n");`
		1148	`output("\tx%u_[1].ag_ptr = y%u_.ptr;\\\n");`
		1149	`output(" }\n\n");`
		1150	`unique++;`
2	7u83	1151
		1152	`/* Vector pointer dereference */`
6	7u83	1153	`output("#define DEREF_vec_ptr(A, B)\\\n");`
		1154	`output(" {\\\n");`
		1155	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1156	`output("\t%X_VEC_PTR *y%u_ = &(B);\\\n");`
		1157	`output("\ty%u_->vec = x%u_->ag_ptr;\\\n");`
		1158	`output("\ty%u_->ptr = x%u_[1].ag_ptr;\\\n");`
		1159	`output(" }\n\n");`
		1160	`unique++;`
2	7u83	1161
		1162	`/* Vector pointer list constructor */`
6	7u83	1163	`output("#define CONS_vec_ptr(A, B, C)\\\n");`
		1164	`output(" {\\\n");`
		1165	`g = gen(SIZE_VEC_PTR + 1, "list");`
		1166	`output("\t%X *x%u_ = %e;\\\n", g);`
		1167	`output("\t%X_VEC_PTR y%u_;\\\n");`
		1168	`output("\ty%u_ = (A);\\\n");`
		1169	`output("\tx%u_[1].ag_ptr = y%u_.vec;\\\n");`
		1170	`output("\tx%u_[2].ag_ptr = y%u_.ptr;\\\n");`
		1171	`output("\tx%u_->ag_ptr = (B);\\\n");`
		1172	`output("\t(C) = x%u_;\\\n");`
		1173	`output(" }\n\n");`
		1174	`unique++;`
2	7u83	1175
		1176	`/* Vector pointer list deconstructor */`
6	7u83	1177	`output("#define UN_CONS_vec_ptr(A, B, C)\\\n");`
		1178	`output(" {\\\n");`
		1179	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		1180	`output("\t%X_VEC_PTR *y%u_ = &(A);\\\n");`
		1181	`output("\ty%u_->vec = x%u_[1].ag_ptr;\\\n");`
		1182	`output("\ty%u_->ptr = x%u_[2].ag_ptr;\\\n");`
		1183	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		1184	`output(" }\n\n");`
		1185	`unique++;`
2	7u83	1186
		1187	`/* Vector pointer list destructor */`
6	7u83	1188	`output("#define DESTROY_CONS_vec_ptr(D, A, B, C)\\\n");`
		1189	`output(" {\\\n");`
		1190	`output("\t%X *x%u_ = %s(C);\\\n", check_null);`
		1191	`output("\t%X_VEC_PTR *y%u_ = &(A);\\\n");`
		1192	`output("\ty%u_->vec = x%u_[1].ag_ptr;\\\n");`
		1193	`output("\ty%u_->ptr = x%u_[2].ag_ptr;\\\n");`
		1194	`output("\t(B) = x%u_->ag_ptr;\\\n");`
		1195	`output("\t(D)(x%u_, (unsigned)3);\\\n");`
		1196	`output(" }\n\n");`
		1197	`unique++;`
2	7u83	1198
6	7u83	1199	`if (allow_stack) {`
2	7u83	1200	`/* Vector stack constructor */`
6	7u83	1201	`output("#define PUSH_vec_ptr(A, B)\\\n");`
		1202	`output(" {\\\n");`
		1203	`output("\t%X **r%u_ = &(B);\\\n");`
		1204	`g = gen(SIZE_VEC_PTR + 1, "stack");`
		1205	`output("\t%X *x%u_ = %e;\\\n", g);`
		1206	`output("\t%X_VEC_PTR y%u_;\\\n");`
		1207	`output("\ty%u_ = (A);\\\n");`
		1208	`output("\tx%u_[1].ag_ptr = y%u_.vec;\\\n");`
		1209	`output("\tx%u_[2].ag_ptr = y%u_.ptr;\\\n");`
		1210	`output("\tx%u_->ag_ptr = *r%u_;\\\n");`
		1211	`output("\t*r%u_ = x%u_;\\\n");`
		1212	`output(" }\n\n");`
		1213	`unique++;`
2	7u83	1214
		1215	`/* Vector stack destructor */`
6	7u83	1216	`output("#define POP_vec_ptr(A, B)\\\n");`
		1217	`output(" {\\\n");`
		1218	`output("\t%X **r%u_ = &(B);\\\n");`
		1219	`output("\t%X x%u_ = %s(r%u_);\\\n", check_null);`
		1220	`output("\t%X_VEC *y%u_ = &(A);\\\n");`
		1221	`output("\ty%u_->vec = x%u_[1].ag_ptr;\\\n");`
		1222	`output("\ty%u_->ptr = x%u_[2].ag_ptr;\\\n");`
		1223	`output("\t*r%u_ = x%u_->ag_ptr;\\\n");`
		1224	`output("\tdestroy_%X(x%u_, (unsigned)3);\\\n");`
		1225	`output(" }\n\n");`
		1226	`unique++;`
2	7u83	1227	`}`
		1228
6	7u83	1229	`output("\n");`
		1230	`return;`
2	7u83	1231	`}`
		1232
		1233
		1234	`/*`
6	7u83	1235	`* PRINT SIZE CONSTRUCTS (C VERSION)`
		1236	`*`
		1237	`* This routine prints the C versions of the size constructs.`
		1238	`*/`
2	7u83	1239
6	7u83	1240	`static void`
		1241	`print_size_c(void)`
2	7u83	1242	`{`
6	7u83	1243	`comment("Definitions for sizes");`
		1244	`output("#define SCALE(A, B)%t40((A)*(int)(B))\n\n\n");`
		1245	`return;`
2	7u83	1246	`}`
		1247
		1248
		1249	`/*`
6	7u83	1250	`* PRINT PRIMITIVE CONSTRUCTS (C VERSION)`
		1251	`*`
		1252	`* This routine prints the C versions of the primitive constructs.`
		1253	`*/`
2	7u83	1254
6	7u83	1255	`static void`
		1256	`print_prim_c(void)`
2	7u83	1257	`{`
6	7u83	1258	`comment("Definitions for primitive %PN");`
		1259	`output("#define SIZE_%PM%t40%d\n\n", SIZE_PRIM);`
		1260	`output("#define COPY_%PM(A, B)%t40");`
		1261	`output("(%s(A)->ag_prim_%PM = (B))\n", check_null);`
		1262	`output("#define DEREF_%PM(A)%t40");`
		1263	`output("(%s(A)->ag_prim_%PM)\n", check_null);`
		1264	`print_simple_cons("%PM", SIZE_PRIM, 1);`
		1265	`return;`
2	7u83	1266	`}`
		1267
		1268
		1269	`/*`
6	7u83	1270	`* PRINT ENUMERATION CONSTANTS`
		1271	`*`
		1272	`* This routine prints the definitions of the enumeration constants.`
		1273	`*/`
2	7u83	1274
6	7u83	1275	`void`
		1276	`print_enum_consts(void)`
2	7u83	1277	`{`
6	7u83	1278	`number n = DEREF_number(en_order(CRT_ENUM));`
		1279	`if (n > (number)0x10000) {`
		1280	`output("#ifdef __STDC__\n");`
		1281	`LOOP_ENUM_CONST output("#define %EM_%ES%t40((%EN) %EVUL)\n");`
		1282	`output("#define ORDER_%EM%t40(%EOUL)\n");`
		1283	`output("#else\n");`
2	7u83	1284	`}`
6	7u83	1285	`LOOP_ENUM_CONST output("#define %EM_%ES%t40((%EN) %EV)\n");`
		1286	`output("#define ORDER_%EM%t40((unsigned long) %EO)\n");`
		1287	`if (n > (number)0x10000) {`
		1288	`output("#endif\n");`
2	7u83	1289	`}`
6	7u83	1290	`return;`
2	7u83	1291	`}`
		1292
		1293
		1294	`/*`
6	7u83	1295	`* PRINT ENUMERATION CONSTRUCTS (C VERSION)`
		1296	`*`
		1297	`* This routine prints the C versions of the enumeration constructs.`
		1298	`*/`
2	7u83	1299
6	7u83	1300	`static void`
		1301	`print_enum_c(void)`
2	7u83	1302	`{`
6	7u83	1303	`char *fld = "ag_enum";`
		1304	`number n = DEREF_number(en_order(CRT_ENUM));`
		1305	`if (n > (number)0x10000) {`
		1306	`fld = "ag_long_enum";`
		1307	`}`
		1308	`comment("Definitions for enumeration %EN");`
		1309	`print_enum_consts();`
		1310	`output("#define SIZE_%EM%t40%d\n\n", SIZE_ENUM);`
		1311	`output("#define COPY_%EM(A, B)%t40");`
		1312	`output("(%s(A)->%s = (B))\n", check_null, fld);`
		1313	`output("#define DEREF_%EM(A)%t40");`
		1314	`output("(%s(A)->%s)\n", check_null, fld);`
		1315	`if (DEREF_int(en_lists(CRT_ENUM))) {`
		1316	`print_simple_cons("%EM", SIZE_ENUM, 1);`
2	7u83	1317	`} else {`
6	7u83	1318	`output("\n\n");`
2	7u83	1319	`}`
6	7u83	1320	`return;`
2	7u83	1321	`}`
		1322
		1323
		1324	`/*`
6	7u83	1325	`* PRINT STRUCTURE CONSTRUCTS (C VERSION)`
		1326	`*`
		1327	`* This routine prints the C versions of the structure constructs.`
		1328	`*/`
2	7u83	1329
6	7u83	1330	`static void`
		1331	`print_struct_c(void)`
2	7u83	1332	`{`
		1333	`/* Structure constructors etc. */`
6	7u83	1334	`int posn;`
		1335	`int sz = 0;`
		1336	`STRUCTURE_P base = DEREF_ptr(str_base(CRT_STRUCTURE));`
2	7u83	1337
6	7u83	1338	`comment("Definitions for structure %SN");`
2	7u83	1339	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	1340	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1341	`output("#define %SM_%CN(P)%t40");`
		1342	`output("((P) + %d)\n", sz);`
		1343	`sz += size_type(ct, 0);`
2	7u83	1344	`}`
6	7u83	1345	`output("#define SIZE_%SM%t40%d\n\n", sz);`
2	7u83	1346
6	7u83	1347	`output("#define COPY_%SM(A, B)\\\n");`
		1348	`output(" {\\\n");`
		1349	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1350	`output("\t%SN y%u_;\\\n");`
		1351	`output("\ty%u_ = (B);\\\n");`
		1352	`posn = 0;`
2	7u83	1353	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	1354	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1355	`posn = assign_component(ct, posn, "y%u_.%CN", 0);`
2	7u83	1356	`}`
6	7u83	1357	`output(" }\n\n");`
		1358	`unique++;`
2	7u83	1359
6	7u83	1360	`output("#define DEREF_%SM(A, B)\\\n");`
		1361	`output(" {\\\n");`
		1362	`output("\t%X *x%u_ = %s(A);\\\n", check_null);`
		1363	`output("\t%SN *y%u_ = &(B);\\\n");`
		1364	`posn = 0;`
2	7u83	1365	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	1366	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1367	`posn = deref_component(ct, posn, "y%u_->%CN", 0);`
2	7u83	1368	`}`
6	7u83	1369	`output(" }\n\n");`
		1370	`unique++;`
2	7u83	1371
6	7u83	1372	`output("#define MAKE_%SM(");`
2	7u83	1373	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	1374	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1375	`if (v == NULL) {`
		1376	`output("%CN_, ");`
		1377	`}`
2	7u83	1378	`}`
6	7u83	1379	`output("%SM_)\\\n");`
		1380	`output(" {\\\n");`
		1381	`output("\t%X *x%u_ = %s(%SM_);\\\n", check_null);`
		1382	`posn = 0;`
2	7u83	1383	`LOOP_STRUCTURE_COMPONENT {`
6	7u83	1384	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1385	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1386	`if (v == NULL) {`
		1387	`v = "(%CN_)";`
		1388	`}`
		1389	`posn = assign_component(ct, posn, v, 0);`
2	7u83	1390	`}`
6	7u83	1391	`output(" }\n\n");`
		1392	`unique++;`
2	7u83	1393
6	7u83	1394	`if (!IS_NULL_ptr(base)) {`
		1395	`CLASS_ID_P id = DEREF_ptr(str_id(base));`
		1396	`char *nm = DEREF_string(cid_name_aux(id));`
		1397	`output("#define CONVERT_%SM_%s(P)%t40(P)\n\n", nm);`
2	7u83	1398	`}`
		1399
6	7u83	1400	`print_simple_cons("%SM", sz, 0);`
		1401	`return;`
2	7u83	1402	`}`
		1403
		1404
		1405	`/*`
6	7u83	1406	`* PRINT UNION CONSTRUCTS (C VERSION)`
		1407	`*`
		1408	`* This routine prints the C versions of the union constructs.`
		1409	`*/`
2	7u83	1410
6	7u83	1411	`static void`
		1412	`print_union_c(void)`
2	7u83	1413	`{`
6	7u83	1414	`UNION_P base = DEREF_ptr(un_base(CRT_UNION));`
2	7u83	1415
6	7u83	1416	`comment("Definitions for union %UN");`
		1417	`output("#define ORDER_%UM%t40((unsigned) %UO)\n");`
		1418	`output("#define SIZE_%UM%t40%d\n", SIZE_UNION);`
		1419	`output("#define NULL_%UM%t40((%UN) 0)\n");`
		1420	`output("#define IS_NULL_%UM(A)%t40((A) == 0)\n");`
		1421	`output("#define EQ_%UM(A, B)%t40((A) == (B))\n\n");`
		1422	`output("#define COPY_%UM(A, B)%t40");`
		1423	`output("(%s(A)->ag_ptr = (B))\n", check_null);`
		1424	`output("#define DEREF_%UM(A)%t40");`
		1425	`output("(%s(A)->ag_ptr)\n\n", check_null);`
2	7u83	1426
6	7u83	1427	`if (!IS_NULL_ptr(base)) {`
		1428	`CLASS_ID_P id = DEREF_ptr(un_id(base));`
		1429	`char *nm = DEREF_string(cid_name_aux(id));`
		1430	`output("#define CONVERT_%UM_%s(P)%t40(P)\n\n", nm);`
2	7u83	1431	`}`
		1432
6	7u83	1433	`print_simple_cons("%UM", SIZE_UNION, 1);`
		1434	`return;`
2	7u83	1435	`}`
		1436
		1437
		1438	`/*`
6	7u83	1439	`* PRINT THE MAIN OUTPUT FILE`
		1440	`*`
		1441	`* This routine prints the main output file, describing the implementation`
		1442	`* of the various types described in the calculus.`
		1443	`*/`
2	7u83	1444
6	7u83	1445	`static void`
		1446	`print_main_c(void)`
2	7u83	1447	`{`
6	7u83	1448	`if (extra_headers) {`
		1449	`output("#include \"%s_bscs.h\"\n\n", MAIN_PREFIX);`
2	7u83	1450	`}`
6	7u83	1451	`output("#ifndef %X_NAME\n");`
		1452	`output("#define %X_NAME%t40\"%X\"\n");`
		1453	`output("#define %X_VERSION%t40\"%V\"\n");`
		1454	`output("#define %X_SPECIFICATION%t40%d\n", 0);`
		1455	`output("#define %X_IMPLEMENTATION%t40%d\n", 1);`
		1456	`output("#endif\n\n\n");`
2	7u83	1457
6	7u83	1458	`print_proto();`
		1459	`print_types_c();`
		1460	`print_ptr_c();`
		1461	`print_list_c();`
		1462	`if (allow_stack) {`
		1463	`print_stack_c();`
2	7u83	1464	`}`
6	7u83	1465	`if (allow_vec) {`
		1466	`print_vec_c();`
		1467	`print_vec_ptr_c();`
2	7u83	1468	`}`
6	7u83	1469	`print_size_c();`
2	7u83	1470
6	7u83	1471	`LOOP_PRIMITIVE print_prim_c();`
		1472	`LOOP_ENUM print_enum_c();`
		1473	`LOOP_STRUCTURE print_struct_c();`
		1474	`LOOP_UNION print_union_c();`
2	7u83	1475
6	7u83	1476	`if (extra_headers) {`
		1477	`output("#include \"%s_term.h\"\n\n", MAIN_PREFIX);`
2	7u83	1478	`}`
6	7u83	1479	`return;`
2	7u83	1480	`}`
		1481
		1482
		1483	`/*`
6	7u83	1484	`* PRINT ARGUMENTS FOR A UNION CONSTRUCTOR`
		1485	`*`
		1486	`* This routine prints the list of arguments for a union constructor and`
		1487	`* similar functions.`
		1488	`*/`
2	7u83	1489
6	7u83	1490	`static void`
		1491	`print_cons_args(int d, char *suff)`
2	7u83	1492	`{`
		1493	`LOOP_UNION_COMPONENT {`
6	7u83	1494	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1495	`if (v == NULL \|\| d == 0) {`
		1496	`output("%CN%s, ", suff);`
		1497	`}`
2	7u83	1498	`}`
		1499	`LOOP_FIELD_COMPONENT {`
6	7u83	1500	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1501	`if (v == NULL \|\| d == 0) {`
		1502	`output("%CN%s, ", suff);`
		1503	`}`
2	7u83	1504	`}`
6	7u83	1505	`output("%X_%UM");`
		1506	`return;`
2	7u83	1507	`}`
		1508
		1509
		1510	`/*`
6	7u83	1511	`* DOES THE CURRENT FIELD HAVE ANY COMPONENTS?`
		1512	`*`
		1513	`* This routine returns 1 if the current field of the current union has`
		1514	`* a component, and 0 otherwise.`
		1515	`*/`
2	7u83	1516
6	7u83	1517	`int`
		1518	`field_not_empty(void)`
2	7u83	1519	`{`
6	7u83	1520	`LIST(COMPONENT_P)c;`
		1521	`c = DEREF_list(un_s_defn(CRT_UNION));`
		1522	`if (!IS_NULL_list(c)) {`
		1523	`return(1);`
		1524	`}`
		1525	`c = DEREF_list(fld_defn(CRT_FIELD));`
		1526	`if (!IS_NULL_list(c)) {`
		1527	`return(1);`
		1528	`}`
		1529	`return(0);`
2	7u83	1530	`}`
		1531
		1532
		1533	`/*`
6	7u83	1534	`* PRINT FIELD SELECTOR OPERATIONS`
		1535	`*`
		1536	`* This routine prints the operations on field selectors (C version).`
		1537	`* sz gives the size of the common union components. tag is the field`
		1538	`* tag number (or -1 for untagged unions). rng gives the number of`
		1539	`* elements in the field set (if appropriate). al is true if the`
		1540	`* field is aliased.`
		1541	`*/`
2	7u83	1542
6	7u83	1543	`static void`
		1544	`print_field_c(int sz, int tag, int rng, int al)`
2	7u83	1545	`{`
6	7u83	1546	`char *g;`
		1547	`int posn = 0;`
		1548	`char *f = (rng ? "%FN_etc" : "%FN");`
2	7u83	1549
		1550	`LOOP_FIELD_COMPONENT {`
6	7u83	1551	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1552	`output("#define %UM_%e_%CN(P)%t40", f);`
		1553	`if (extra_asserts && tag != -1) {`
		1554	`if (rng) {`
		1555	`output("(CHECK_TAG_ETC((P), %d, %d) + %d)\n",`
		1556	`tag, tag + rng, sz);`
2	7u83	1557	`} else {`
6	7u83	1558	`output("(CHECK_TAG((P), %d) + %d)\n", tag, sz);`
2	7u83	1559	`}`
		1560	`} else {`
6	7u83	1561	`output("((P) + %d)\n", sz);`
2	7u83	1562	`}`
6	7u83	1563	`sz += size_type(ct, 0);`
2	7u83	1564	`}`
		1565
		1566	`/* Component constructor */`
6	7u83	1567	`output("\n#define MAKE_%UM_%e(", f);`
		1568	`if (rng) {`
		1569	`output("tag, ");`
		1570	`}`
		1571	`print_cons_args(1, "_");`
		1572	`output(")\\\n");`
		1573	`output(" {\\\n");`
		1574	`g = gen(sz + al, "%UM");`
		1575	`output("\t%X *x%u_ = %e;\\\n", g);`
		1576	`if (tag != -1) {`
		1577	`if (rng) {`
		1578	`output("\tx%u_->ag_tag = (tag);\\\n");`
2	7u83	1579	`} else {`
6	7u83	1580	`output("\tx%u_->ag_tag = %d;\\\n", tag);`
2	7u83	1581	`}`
6	7u83	1582	`posn = 1;`
2	7u83	1583	`}`
		1584	`LOOP_UNION_COMPONENT {`
6	7u83	1585	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1586	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1587	`if (v == NULL) {`
		1588	`v = "(%CN_)";`
		1589	`}`
		1590	`posn = assign_component(ct, posn, v, 0);`
2	7u83	1591	`}`
		1592	`LOOP_FIELD_COMPONENT {`
6	7u83	1593	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1594	`string v = DEREF_string(cmp_value(CRT_COMPONENT));`
		1595	`if (v == NULL) {`
		1596	`v = "(%CN_)";`
		1597	`}`
		1598	`posn = assign_component(ct, posn, v, 0);`
2	7u83	1599	`}`
6	7u83	1600	`if (al) {`
		1601	`output("\tx%u_[%d].ag_tag = 0;\\\n", sz);`
		1602	`}`
		1603	`if (rng && extra_asserts) {`
		1604	`output("\t(%X_%UM) = CHECK_TAG_ETC(x%u_, %d, %d);\\\n",`
		1605	`tag, tag + rng);`
2	7u83	1606	`} else {`
6	7u83	1607	`output("\t(%X_%UM) = x%u_;\\\n");`
2	7u83	1608	`}`
6	7u83	1609	`output(" }\n\n");`
		1610	`unique++;`
2	7u83	1611
		1612	`/* Tag modifier */`
6	7u83	1613	`if (rng) {`
		1614	`output("#define MODIFY_%UM_%e(tag, %X_%UM)\\\n", f);`
		1615	`output(" {\\\n");`
		1616	`if (extra_asserts) {`
		1617	`output("\t%X *x%u_ = CHECK_TAG_ETC");`
		1618	`output(" ((%X_%UM), %d, %d);\\\n", tag, tag + rng);`
		1619	`output("\tx%u_->ag_tag = (tag);\\\n");`
		1620	`output("\t(void) CHECK_TAG_ETC");`
		1621	`output(" (x%u_, %d, %d);\\\n", tag, tag + rng);`
2	7u83	1622	`} else {`
6	7u83	1623	`output("\t(%X_%UM)->ag_tag = (tag);\\\n");`
2	7u83	1624	`}`
6	7u83	1625	`output(" }\n\n");`
		1626	`unique++;`
2	7u83	1627	`}`
		1628
		1629	`/* Component deconstructor */`
6	7u83	1630	`if (field_not_empty()) {`
		1631	`output("#define DECONS_%UM_%e(", f);`
		1632	`print_cons_args(0, "_");`
		1633	`output(")\\\n");`
		1634	`output(" {\\\n");`
		1635	`output("\t%X *x%u_ = ");`
		1636	`if (tag != -1) {`
		1637	`if (extra_asserts) {`
		1638	`if (rng) {`
		1639	`output("CHECK_TAG_ETC((%X_%UM), %d, %d);\\\n",`
		1640	`tag, tag + rng);`
2	7u83	1641	`} else {`
6	7u83	1642	`output("CHECK_TAG((%X_%UM), %d);\\\n", tag);`
2	7u83	1643	`}`
		1644	`} else {`
6	7u83	1645	`output("(%X_%UM);\\\n");`
2	7u83	1646	`}`
6	7u83	1647	`posn = 1;`
2	7u83	1648	`} else {`
6	7u83	1649	`output("(%X_%UM);\\\n");`
		1650	`posn = 0;`
2	7u83	1651	`}`
		1652	`LOOP_UNION_COMPONENT {`
6	7u83	1653	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1654	`posn = deref_component(ct, posn, "(%CN_)", 0);`
2	7u83	1655	`}`
		1656	`LOOP_FIELD_COMPONENT {`
6	7u83	1657	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1658	`posn = deref_component(ct, posn, "(%CN_)", 0);`
2	7u83	1659	`}`
6	7u83	1660	`output(" }\n\n");`
		1661	`unique++;`
2	7u83	1662	`}`
		1663
		1664	`/* Component destructor */`
6	7u83	1665	`output("#define DESTROY_%UM_%e(destroyer_, ", f);`
		1666	`print_cons_args(0, "_");`
		1667	`output(")\\\n");`
		1668	`output(" {\\\n");`
		1669	`output("\t%X *x%u_ = ");`
		1670	`if (tag != -1) {`
		1671	`if (extra_asserts) {`
		1672	`if (rng) {`
		1673	`output("CHECK_TAG_ETC((%X_%UM), %d, %d);\\\n",`
		1674	`tag, tag + rng);`
2	7u83	1675	`} else {`
6	7u83	1676	`output("CHECK_TAG((%X_%UM), %d);\\\n", tag);`
2	7u83	1677	`}`
		1678	`} else {`
6	7u83	1679	`output("(%X_%UM);\\\n");`
2	7u83	1680	`}`
6	7u83	1681	`posn = 1;`
2	7u83	1682	`} else {`
6	7u83	1683	`output("(%X_%UM);\\\n");`
		1684	`posn = 0;`
2	7u83	1685	`}`
		1686	`LOOP_UNION_COMPONENT {`
6	7u83	1687	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1688	`posn = deref_component(ct, posn, "(%CN_)", 0);`
2	7u83	1689	`}`
		1690	`LOOP_FIELD_COMPONENT {`
6	7u83	1691	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1692	`posn = deref_component(ct, posn, "(%CN_)", 0);`
2	7u83	1693	`}`
6	7u83	1694	`output("\t(destroyer_)(x%u_, (unsigned)%d);\\\n", sz + al);`
		1695	`output(" }\n\n");`
		1696	`unique++;`
2	7u83	1697
		1698	`/* Aliasing commands */`
6	7u83	1699	`if (al && !rng) {`
		1700	`output("#ifdef %X_IO_ROUTINES\n\n");`
		1701	`output("#define NEW_ALIAS_%UM_%FN(P, N)\\\n");`
		1702	`output(" {\\\n");`
		1703	`g = gen(sz + al, "list");`
		1704	`output("\t%X *x%u_ = %e;\\\n", g);`
		1705	`output("\tunsigned a%u_ = (N);\\\n");`
		1706	`if (tag != -1) {`
		1707	`output("\tx%u_->ag_tag = %d;\\\n", tag);`
		1708	`}`
		1709	`output("\tx%u_[%d].ag_tag = a%u_;\\\n", sz);`
		1710	`output("\tset_%X_alias(x%u_ + %d, a%u_);\\\n", sz);`
		1711	`output("\t(P) = x%u_;\\\n");`
		1712	`output(" }\n\n");`
		1713	`unique++;`
2	7u83	1714
6	7u83	1715	`output("#define GET_ALIAS_%UM_%FN(P)%t40");`
		1716	`output("((%s(P) + %d)->ag_tag)\n", check_null, sz);`
		1717	`output("#define SET_ALIAS_%UM_%FN(P, N)%t40");`
		1718	`output("set_%X_alias(%s(P) + %d, (N))\n", check_null, sz);`
		1719	`output("#define FIND_ALIAS_%UM_%FN(N)%t40");`
		1720	`output("(find_%X_alias(N) - %d)\n\n", sz);`
		1721	`output("#endif\n\n");`
2	7u83	1722	`}`
6	7u83	1723	`output("\n");`
		1724	`return;`
2	7u83	1725	`}`
		1726
		1727
		1728	`/*`
6	7u83	1729	`* PRINT DECLARATION FOR A UNION MAP TABLE`
		1730	`*`
		1731	`* This routine prints the type of the current map table.`
		1732	`*/`
2	7u83	1733
6	7u83	1734	`static void`
		1735	`print_map_table(int d)`
2	7u83	1736	`{`
6	7u83	1737	`output("%MR (*%MN_%UM_table[ORDER_%UM])");`
		1738	`if (map_proto) {`
		1739	`output("\n (%UN");`
		1740	`if (d) {`
		1741	`output(", DESTROYER");`
		1742	`}`
		1743	`LOOP_MAP_ARGUMENT output(", %AT");`
		1744	`output(")");`
2	7u83	1745	`} else {`
6	7u83	1746	`output(" ()");`
2	7u83	1747	`}`
6	7u83	1748	`return;`
2	7u83	1749	`}`
		1750
		1751
		1752	`/*`
6	7u83	1753	`* PRINT ARGUMENTS FOR A UNION MAP`
		1754	`*`
		1755	`* This routine prints the list of arguments for the current map. The`
		1756	`* argument d, if present, gives the destructor argument.`
		1757	`*/`
2	7u83	1758
6	7u83	1759	`void`
		1760	`print_map_args(char *d)`
2	7u83	1761	`{`
6	7u83	1762	`output("(%X_%UM");`
		1763	`if (d) {`
		1764	`output(", %e", d);`
		1765	`}`
		1766	`LOOP_MAP_ARGUMENT output(", %AN");`
		1767	`output(")");`
		1768	`return;`
2	7u83	1769	`}`
		1770
		1771
		1772	`/*`
6	7u83	1773	`* PRINT THE UNION OPERATIONS OUTPUT FILE`
		1774	`*`
		1775	`* For each union in the calculus there is an operations file.`
		1776	`*/`
2	7u83	1777
6	7u83	1778	`static void`
		1779	`print_union_ops_c(char dir, char un)`
2	7u83	1780	`{`
6	7u83	1781	`int sz = 1;`
		1782	`int tag = 0;`
		1783	`int is_tagged = 1;`
		1784	`open_file(dir, un, OPS_SUFFIX);`
		1785	`if (extra_headers) {`
		1786	`output("#include \"%s%s\"\n", MAIN_PREFIX, MAIN_SUFFIX);`
		1787	`output("#include <%s_ops.h>\n\n", MAIN_PREFIX);`
2	7u83	1788	`}`
		1789
		1790	`/* Check for unions with one field */`
6	7u83	1791	`LOOP_UNION_FIELD tag++;`
		1792	`if (tag < 2) {`
		1793	`sz = 0;`
		1794	`is_tagged = 0;`
2	7u83	1795	`}`
		1796
6	7u83	1797	`comment("Operations for union %UN");`
		1798	`output("#define TAG_%UM(P)%t40", check_null);`
		1799	`if (is_tagged) {`
		1800	`output("(%s(P)->ag_tag)\n\n\n", check_null);`
2	7u83	1801	`} else {`
6	7u83	1802	`output("((unsigned) 0)\n\n\n");`
2	7u83	1803	`}`
		1804
		1805	`/* Operations on common components */`
		1806	`LOOP_UNION_COMPONENT {`
6	7u83	1807	`TYPE_P ct = DEREF_ptr(cmp_type(CRT_COMPONENT));`
		1808	`comment("Operations for component %CN of union %UN");`
		1809	`output("#define %UM_%CN(P)%t40");`
		1810	`output("(%s(P) + %d)\n\n\n", check_null, sz);`
		1811	`sz += size_type(ct, 0);`
2	7u83	1812	`}`
		1813
		1814	`/* Operations on field components */`
6	7u83	1815	`tag = 0;`
2	7u83	1816	`LOOP_UNION_FIELD {`
6	7u83	1817	`int rng = DEREF_int(fld_set(CRT_FIELD));`
		1818	`int hash = DEREF_int(fld_flag(CRT_FIELD));`
		1819	`int al = (hash ? 1 : 0);`
2	7u83	1820
6	7u83	1821	`if (rng) {`
		1822	`comment("Operations for field set %FN_etc of union %UN");`
		1823	`output("#define %UM_%FN_etc_tag%t40((unsigned)%d)\n",`
		1824	`tag + rng);`
		1825	`output("#define IS_%UM_%FN_etc(P)%t40");`
		1826	`output("((unsigned)(%s(P)->ag_tag - %d)",`
		1827	`check_null, tag);`
		1828	`output(" < (unsigned)%d)\n\n", rng);`
		1829	`print_field_c(sz, tag, rng, al);`
2	7u83	1830	`}`
6	7u83	1831
		1832	`comment("Operations for field %FN of union %UN");`
		1833	`output("#define %UM_%FN_tag%t40((unsigned)%d)\n", tag);`
		1834	`output("#define IS_%UM_%FN(P)%t40");`
		1835	`if (is_tagged) {`
		1836	`output("(%s(P)->ag_tag == %d)\n\n", check_null, tag);`
		1837	`print_field_c(sz, tag, 0, al);`
2	7u83	1838	`} else {`
6	7u83	1839	`output("1\n\n");`
		1840	`print_field_c(sz, -1, 0, al);`
2	7u83	1841	`}`
6	7u83	1842	`ASSERT(DEREF_int(fld_tag(CRT_FIELD)) == tag);`
		1843	`tag++;`
2	7u83	1844	`}`
		1845
		1846	`/* Map tables */`
		1847	`LOOP_UNION_MAP {`
6	7u83	1848	`int hash = DEREF_int(map_flag(CRT_MAP));`
		1849	`char *dest = (hash ? "destroyer" : NULL);`
		1850	`comment("Map %MN on union %UN");`
		1851	`output("extern ");`
		1852	`print_map_table(hash);`
		1853	`output(";\n\n#define %MN_%UM");`
		1854	`print_map_args(dest);`
		1855	`output("\\\n ((%MN_%UM_table[");`
		1856	`if (is_tagged) {`
		1857	`if (extra_asserts) {`
		1858	`output("CHECK_TAG_ETC((%X_%UM), 0, ORDER_%UM)");`
2	7u83	1859	`} else {`
6	7u83	1860	`output("(%X_%UM)");`
2	7u83	1861	`}`
6	7u83	1862	`output("->ag_tag]) ");`
2	7u83	1863	`} else {`
6	7u83	1864	`output("0]) ");`
2	7u83	1865	`}`
6	7u83	1866	`print_map_args(dest);`
		1867	`output(")\n\n\n");`
2	7u83	1868	`}`
		1869
		1870	`/* End of file */`
6	7u83	1871	`close_file();`
		1872	`return;`
2	7u83	1873	`}`
		1874
		1875
		1876	`/*`
6	7u83	1877	`* PRINT A UNION MAPPING TABLE`
		1878	`*`
		1879	`* This routine prints a single union mapping table.`
		1880	`*/`
2	7u83	1881
6	7u83	1882	`static void`
		1883	`print_func_tab(int i)`
2	7u83	1884	`{`
6	7u83	1885	`int hash = DEREF_int(map_flag(CRT_MAP));`
		1886	`comment("Function table for map %MN on union %UN");`
		1887	`if (i) {`
		1888	`output("#ifndef IGNORE_%MN_%UM\n\n");`
		1889	`}`
		1890	`print_map_table(hash);`
		1891	`output(" = {\n");`
		1892	`LOOP_UNION_FIELD output(" %MN_%UM_%FN%F,\n");`
		1893	`output("};\n\n");`
		1894	`if (i) {`
		1895	`output("#endif\n\n");`
		1896	`}`
		1897	`output("\n");`
		1898	`return;`
2	7u83	1899	`}`
		1900
		1901
		1902	`/*`
6	7u83	1903	`* PRINT A FUNCTION HEADER`
		1904	`*`
		1905	`* This routine prints the function headers required in print_union_hdr_c.`
		1906	`* The argument d is true if this is the destructor version. The argument`
		1907	`* e is true if this is the header for a field set.`
		1908	`*/`
2	7u83	1909
6	7u83	1910	`static void`
		1911	`print_func_hdr(int d, int e)`
2	7u83	1912	`{`
6	7u83	1913	`int hash = DEREF_int(map_flag(CRT_MAP));`
		1914	`char *dest = (d ? "_d_" : "_");`
		1915	`char *etc = (e ? "_etc" : "");`
		1916	`output("#define HDR_%MN%s%UM_%FN%s\\\n", dest, etc);`
2	7u83	1917
		1918	`/* Function header */`
6	7u83	1919	`output(" %MR %MN_%UM_%FN\\\n");`
		1920	`print_map_args(hash ? "destroyer" : NULL);`
		1921	`output("\\\n");`
2	7u83	1922
		1923	`/* Function argument declarations */`
6	7u83	1924	`output("\t(%UN %X_%UM");`
		1925	`if (hash) {`
		1926	`output(" X DESTROYER destroyer");`
		1927	`}`
		1928	`LOOP_MAP_ARGUMENT output(" X %AT %AN");`
		1929	`output(")\\\n {");`
2	7u83	1930
		1931	`/* Field component declarations */`
6	7u83	1932	`LOOP_UNION_COMPONENT output("\\\n\t%CT %CN;");`
		1933	`LOOP_FIELD_COMPONENT output("\\\n\t%CT %CN;");`
2	7u83	1934
		1935	`/* Assignment of field components */`
6	7u83	1936	`if (d) {`
		1937	`output("\\\n\tDESTROY_%UM_%FN%s(", etc);`
		1938	`output(hash ? "destroyer, " : "destroy_%X, ");`
		1939	`print_cons_args(0, "");`
		1940	`output(");");`
2	7u83	1941	`} else {`
6	7u83	1942	`if (field_not_empty()) {`
		1943	`output("\\\n\tDECONS_%UM_%FN%s(", etc);`
		1944	`print_cons_args(0, "");`
		1945	`output(");");`
2	7u83	1946	`}`
		1947	`}`
6	7u83	1948	`output("\n\n");`
		1949	`return;`
2	7u83	1950	`}`
		1951
		1952
		1953	`/*`
6	7u83	1954	`* PRINT A UNION MAP OUTPUT FILE`
		1955	`*`
		1956	`* For each union with maps in the calculus a file is printed giving the`
		1957	`* tables which give the actions of each map on each union component.`
		1958	`*/`
2	7u83	1959
6	7u83	1960	`void`
		1961	`print_union_map_c(char dir, char un)`
2	7u83	1962	`{`
6	7u83	1963	`open_file(dir, un, MAP_SUFFIX);`
		1964	`LOOP_UNION_MAP print_func_tab(1);`
		1965	`close_file();`
		1966	`return;`
2	7u83	1967	`}`
		1968
		1969
		1970	`/*`
6	7u83	1971	`* PRINT THE UNION MAPPING HEADERS OUTPUT FILE`
		1972	`*`
		1973	`* For each union with maps in the calculus a file is printed giving the`
		1974	`* function headers for the actions in the previous file. Note that two`
		1975	`* versions of the header are given - a deconstructor and a destructor`
		1976	`* version. Also versions are given for any field sets.`
		1977	`*/`
2	7u83	1978
6	7u83	1979	`void`
		1980	`print_union_hdr_c(char dir, char un)`
2	7u83	1981	`{`
6	7u83	1982	`open_file(dir, un, HDR_SUFFIX);`
2	7u83	1983	`LOOP_UNION_MAP {`
6	7u83	1984	`comment("Function headers for map %MN on union %UN");`
		1985	`output("#ifndef IGNORE_%MN_%UM\n\n");`
2	7u83	1986	`LOOP_UNION_FIELD {`
6	7u83	1987	`print_func_hdr(0, 0);`
		1988	`print_func_hdr(1, 0);`
		1989	`if (DEREF_int(fld_set(CRT_FIELD))) {`
		1990	`print_func_hdr(0, 1);`
		1991	`print_func_hdr(1, 1);`
2	7u83	1992	`}`
		1993	`}`
6	7u83	1994	`output("#endif\n\n\n");`
2	7u83	1995	`}`
6	7u83	1996	`close_file();`
		1997	`return;`
2	7u83	1998	`}`
		1999
		2000
		2001	`/*`
6	7u83	2002	`* MAIN ACTION (C VERSION)`
		2003	`*`
		2004	`* This routine prints all the output files for the calculus (C version).`
		2005	`*/`
2	7u83	2006
6	7u83	2007	`void`
		2008	`main_action_c(char *dir)`
2	7u83	2009	`{`
6	7u83	2010	`int ign = 0;`
		2011	`gen_max = 0;`
		2012	`output_c_code = 1;`
		2013	`check_null = (extra_asserts ? "CHECK_NULL" : "");`
2	7u83	2014
6	7u83	2015	`open_file(dir, MAIN_PREFIX, MAIN_SUFFIX);`
		2016	`print_main_c();`
2	7u83	2017
		2018	`LOOP_UNION {`
6	7u83	2019	`LIST(MAP_P)maps;`
		2020	`CLASS_ID_P cid = DEREF_ptr(un_id(CRT_UNION));`
		2021	`char *un = DEREF_string(cid_name_aux(cid));`
		2022	`print_union_ops_c(dir, un);`
		2023	`maps = DEREF_list(un_map(CRT_UNION));`
		2024	`if (!IS_NULL_list(maps)) {`
		2025	`print_union_map_c(dir, un);`
		2026	`print_union_hdr_c(dir, un);`
		2027	`ign = 1;`
2	7u83	2028	`}`
		2029	`}`
		2030
6	7u83	2031	`comment("Maximum allocation size");`
		2032	`output("#define %X_GEN_MAX%t40%d\n\n", gen_max + 1);`
		2033	`close_file();`
2	7u83	2034
6	7u83	2035	`if (ign) {`
		2036	`open_file(dir, IGNORE_PREFIX, DEF_SUFFIX);`
		2037	`comment("Map ignore macros");`
2	7u83	2038	`LOOP_UNION {`
6	7u83	2039	`LOOP_UNION_MAP output("#define IGNORE_%MN_%UM%t40%d\n", 1);`
2	7u83	2040	`}`
6	7u83	2041	`output("\n");`
		2042	`close_file();`
2	7u83	2043	`}`
		2044
6	7u83	2045	`if (extra_asserts) {`
		2046	`open_file(dir, ASSERT_PREFIX, DEF_SUFFIX);`
		2047	`comment("Assertion function definitions");`
		2048	`print_assert_fns();`
		2049	`close_file();`
2	7u83	2050	`}`
6	7u83	2051	`return;`
2	7u83	2052	`}`

Subversion Repositories tendra.SVN

(root)/branches/tendra5-amd64/src/utilities/calculus/code.c – Rev 6