Subversion Repositories tendra.SVN

Rev

Rev 5 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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 "common.h"
65 
#include "disk.h"
66 
#include "output.h"
67 
#include "suffix.h"
68 
#include "type_ops.h"
69 
 
70 
 
71 
/*
6 7u83 72 
 * OUTPUT ENUMERATION READING ROUTINE
73 
 *
74 
 * This routine outputs code for reading an enumeration type from disk.
75 
 * This is done in two sections for long enumeration types.
76 
 */
2 7u83 77 
 
6 7u83 78 
static void
79 
disk_read_enum(void)
2 7u83 80 
{
6 7u83 81 
    number n = log2(DEREF_number(en_order(CRT_ENUM)));
82 
    if (n <= 16) {
83 
	output("    x_ = (%EN)READ_BITS(%n);\n", n);
2 7u83 84 
    } else {
6 7u83 85 
	n -= 16;
86 
	output("    x_ = (%EN)READ_BITS(16);\n");
87 
	output("    x_ += (((%EN)READ_BITS(%n)) << 16);\n", n);
2 7u83 88 
    }
6 7u83 89 
    return;
2 7u83 90 
}
91 
 
92 
 
93 
/*
6 7u83 94 
 * OUTPUT STRUCTURE READING ROUTINE
95 
 *
96 
 * This routine outputs code for reading a structure type from disk.
97 
 */
2 7u83 98 
 
6 7u83 99 
static void
100 
disk_read_struct(void)
2 7u83 101 
{
102 
    LOOP_STRUCTURE_COMPONENT {
6 7u83 103 
	TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
104 
	output("    x_.%CN = READ_%TI();\n", t);
2 7u83 105 
    }
6 7u83 106 
    return;
2 7u83 107 
}
108 
 
109 
 
110 
/*
6 7u83 111 
 * OUTPUT UNION READING ROUTINE
112 
 *
113 
 * This routine outputs code for reading a union type from disk.
114 
 */
2 7u83 115 
 
6 7u83 116 
static void
117 
disk_read_union(void)
2 7u83 118 
{
6 7u83 119 
    output("    x_ = NULL_%UM;\n");
120 
    output("    if (READ_BITS(1) == 1) {\n");
121 
    LOOP_UNION_COMPONENT output("\t%CT %CN;\n");
122 
    output("\tunsigned tag_ = READ_BITS(%UO2);\n");
123 
    output("\tswitch (tag_) {\n");
2 7u83 124 
    LOOP_UNION_FIELD {
6 7u83 125 
	int al = DEREF_int(fld_flag(CRT_FIELD));
126 
	output("\t    case %UM_%FN_tag: {\n");
127 
	LOOP_FIELD_COMPONENT output("\t\t%CT %CN;\n");
2 7u83 128 
 
129 
	/* Deal with aliasing */
6 7u83 130 
	if (al) {
131 
	    output("\t\tunsigned alias_ = READ_ALIAS();\n");
132 
	    output("\t\tif (READ_BITS(1) == 0) {\n");
133 
	    output("\t\t    x_ = FIND_ALIAS_%UM_%FN(alias_);\n");
134 
	    output("\t\t    break;\n");
135 
	    output("\t\t}\n");
136 
	    if (al == 2) {
137 
		output("\t\tUNALIAS_%UM_%FN(x_);\n");
138 
		output("\t\tSET_ALIAS_%UM_%FN(x_, alias_);\n");
2 7u83 139 
	    } else {
6 7u83 140 
		output("\t\tNEW_ALIAS_%UM_%FN(x_, alias_);\n");
2 7u83 141 
	    }
142 
	}
143 
 
144 
	/* Read the components */
145 
	LOOP_UNION_COMPONENT {
6 7u83 146 
	    TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
147 
	    output("\t\t%CN = READ_%TI();\n", t);
2 7u83 148 
	}
149 
	LOOP_FIELD_COMPONENT {
6 7u83 150 
	    TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
151 
	    output("\t\t%CN = READ_%TI();\n", t);
2 7u83 152 
	}
153 
 
154 
	/* Assign components into x_ */
6 7u83 155 
	if (al == 2) {
156 
	    output("\t\tUNIFY_%UM_%FN(");
157 
	    LOOP_UNION_COMPONENT output("%CN, ");
158 
	    LOOP_FIELD_COMPONENT output("%CN, ");
159 
	    output("x_);\n");
160 
	    output("\t\tSET_ALIAS_%UM_%FN(x_, alias_);\n");
161 
	} else if (al) {
2 7u83 162 
	    LOOP_UNION_COMPONENT {
6 7u83 163 
		TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
164 
		output("\t\tCOPY_%TM(%UM_%CN(x_), %CN);\n", t);
2 7u83 165 
	    }
166 
	    LOOP_FIELD_COMPONENT {
6 7u83 167 
		TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
168 
		output("\t\tCOPY_%TM(%UM_%FN_%CN(x_), %CN);\n", t);
2 7u83 169 
	    }
170 
	} else {
6 7u83 171 
	    int def = 0;
172 
	    output("\t\tMAKE_%UM_%FN(");
2 7u83 173 
	    LOOP_UNION_COMPONENT {
6 7u83 174 
		string v = DEREF_string(cmp_value(CRT_COMPONENT));
175 
		if (v == NULL) {
176 
		    output("%CN, ");
2 7u83 177 
		} else {
6 7u83 178 
		    def = 1;
2 7u83 179 
		}
180 
	    }
181 
	    LOOP_FIELD_COMPONENT {
6 7u83 182 
		string v = DEREF_string(cmp_value(CRT_COMPONENT));
183 
		if (v == NULL) {
184 
		    output("%CN, ");
2 7u83 185 
		} else {
6 7u83 186 
		    def = 1;
2 7u83 187 
		}
188 
	    }
6 7u83 189 
	    output("x_ );\n");
190 
	    if (def) {
2 7u83 191 
		/* Override default values */
192 
		LOOP_UNION_COMPONENT {
6 7u83 193 
		    string v = DEREF_string(cmp_value(CRT_COMPONENT));
194 
		    if (v) {
195 
			TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
196 
			output("\t\tCOPY_%TM ", t);
197 
			output("(%UM_%CN(x_), %CN);\n");
2 7u83 198 
		    }
199 
		}
200 
		LOOP_FIELD_COMPONENT {
6 7u83 201 
		    string v = DEREF_string(cmp_value(CRT_COMPONENT));
202 
		    if (v) {
203 
			TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
204 
			output("\t\tCOPY_%TM ", t);
205 
			output("(%UM_%FN_%CN(x_), %CN);\n");
2 7u83 206 
		    }
207 
		}
208 
	    }
209 
	}
6 7u83 210 
	output("\t\tbreak;\n");
211 
	output("\t    }\n");
2 7u83 212 
    }
6 7u83 213 
    output("\t}\n");
214 
    output("    }\n");
215 
    return;
2 7u83 216 
}
217 
 
218 
 
219 
/*
6 7u83 220 
 * PRINT THE DISK READING DEFINITIONS
221 
 *
222 
 * This routine prints all the routines for reading the various types
223 
 * from disk.
224 
 */
2 7u83 225 
 
6 7u83 226 
static void
227 
disk_read_def(char *dir)
2 7u83 228 
{
6 7u83 229 
    open_file(dir, READ_PREFIX, DEF_SUFFIX);
230 
    print_include();
2 7u83 231 
 
6 7u83 232 
    comment("Disk reading function declarations");
2 7u83 233 
    LOOP_TYPE {
6 7u83 234 
	TYPE_P t = CRT_TYPE;
235 
	TYPE t0 = DEREF_type(t);
236 
	unsigned tag = TAG_type(t0);
237 
	if (is_identity_type(t)) {
238 
	    output("#ifndef READ_%TI\n", t);
239 
	    output("#define READ_%TI() READ_%TJ()\n", t, t);
240 
	    output("#endif\n\n");
241 
	} else if (tag != type_primitive_tag) {
242 
	    output("#ifndef READ_%TI\n", t);
243 
	    output("static %TT READ_%TI(void);\n", t, t);
244 
	    output("#endif\n\n");
2 7u83 245 
	}
246 
    }
6 7u83 247 
    output("\n");
2 7u83 248 
 
249 
    /* Function definitions */
250 
    LOOP_TYPE {
6 7u83 251 
	TYPE_P t = CRT_TYPE;
252 
	TYPE t0 = DEREF_type(t);
253 
	unsigned tag = TAG_type(t0);
254 
	if (!is_identity_type(t) && tag != type_primitive_tag) {
2 7u83 255 
	    /* Function header */
6 7u83 256 
	    output("/* Disk reading routine for %TT */\n\n", t);
257 
	    output("#ifndef READ_%TI\n\n", t);
258 
	    output("static %TT READ_%TI\n", t, t);
259 
	    output("(void)\n");
260 
	    output("{\n");
261 
	    output("    %TT x_;\n", t);
2 7u83 262 
 
263 
	    /* Function body */
6 7u83 264 
	    switch (tag) {
2 7u83 265 
 
6 7u83 266 
		case type_enumeration_tag: {
267 
		    ENUM_P p = DEREF_ptr(type_enumeration_en(t0));
2 7u83 268 
		    LOOP_ENUM {
6 7u83 269 
			if (EQ_ptr(CRT_ENUM, p)) {
270 
			    disk_read_enum();
271 
			    break;
2 7u83 272 
			}
273 
		    }
6 7u83 274 
		    break;
2 7u83 275 
		}
276 
 
6 7u83 277 
		case type_structure_tag: {
278 
		    STRUCTURE_P p = DEREF_ptr(type_structure_struc(t0));
2 7u83 279 
		    LOOP_STRUCTURE {
6 7u83 280 
			if (EQ_ptr(CRT_STRUCTURE, p)) {
281 
			    disk_read_struct();
282 
			    break;
2 7u83 283 
			}
284 
		    }
6 7u83 285 
		    break;
2 7u83 286 
		}
287 
 
6 7u83 288 
		case type_onion_tag: {
289 
		    UNION_P p = DEREF_ptr(type_onion_un(t0));
2 7u83 290 
		    LOOP_UNION {
6 7u83 291 
			if (EQ_ptr(CRT_UNION, p)) {
292 
			    disk_read_union();
293 
			    break;
2 7u83 294 
			}
295 
		    }
6 7u83 296 
		    break;
2 7u83 297 
		}
298 
 
6 7u83 299 
		case type_ptr_tag: {
300 
		    TYPE_P s = DEREF_ptr(type_ptr_sub(t0));
301 
		    output("    if (READ_BITS(1) == 0) {\n");
302 
		    output("\tx_ = NULL_ptr(%TT);\n", s);
303 
		    output("    } else {\n");
304 
		    output("\tx_ = MAKE_ptr(%TS);\n", s);
305 
		    output("\tCOPY_%TM(x_, READ_%TI());\n", s, s);
306 
		    output("    }\n");
307 
		    break;
2 7u83 308 
		}
309 
 
6 7u83 310 
		case type_list_tag: {
311 
		    TYPE_P s = DEREF_ptr(type_list_sub(t0));
312 
		    output("    x_ = NULL_list(%TT);\n", s);
313 
		    output("    while (READ_BITS(1)) {\n");
314 
		    output("\t%TT y_;\n", s);
315 
		    output("\t%TT z_;\n", t);
316 
		    output("\ty_ = READ_%TI();\n", s);
317 
		    output("\tCONS_%TM(y_, NULL_list(%TT), z_);\n",
318 
			     s, s);
319 
		    output("\tx_ = APPEND_list(x_, z_);\n");
320 
		    output("    }\n");
321 
		    break;
2 7u83 322 
		}
323 
 
6 7u83 324 
		case type_stack_tag: {
325 
		    TYPE_P s = DEREF_ptr(type_stack_sub(t0));
326 
		    output("    LIST(%TT) w_;\n", s);
327 
		    output("    w_ = NULL_list(%TT);\n", s);
328 
		    output("    while (READ_BITS(1)) {\n");
329 
		    output("\t%TT y_;\n", s);
330 
		    output("\t%TT z_;\n", t);
331 
		    output("\ty_ = READ_%TI();\n", s);
332 
		    output("\tCONS_%TM(y_, NULL_list(%TT), z_);\n",
333 
			     s, s);
334 
		    output("\tw_ = APPEND_list(w_, z_);\n");
335 
		    output("    }\n");
336 
		    output("    x_ = STACK_list(w_);\n");
337 
		    break;
2 7u83 338 
		}
339 
 
6 7u83 340 
		case type_vec_tag: {
341 
		    TYPE_P s = DEREF_ptr(type_vec_sub(t0));
342 
		    output("    PTR(%TT)y_;\n", s);
343 
		    output("    %X_dim n_ = (%X_dim)READ_DIM();\n");
344 
		    output("    MAKE_vec(%TS, n_, x_);\n", s);
345 
		    output("    y_ = PTR_vec_ptr(");
346 
		    output("VEC_PTR_vec(x_));\n");
347 
		    output("    while (n_--) {\n");
348 
		    output("\tCOPY_%TM(y_, READ_%TI());\n", s, s);
349 
		    output("\ty_ = STEP_ptr(y_, %TS);\n", s);
350 
		    output("    }\n");
351 
		    break;
2 7u83 352 
		}
353 
 
6 7u83 354 
		case type_vec_ptr_tag: {
355 
		    TYPE_P s = DEREF_ptr(type_vec_ptr_sub(t0));
356 
		    output("    VEC(%TT)y_;\n", s);
357 
		    output("    PTR(%TT)z_;\n", s);
358 
		    output("    MAKE_vec(%TS, (%X_dim)1, y_);\n", s);
359 
		    output("    x_ = VEC_PTR_vec(y_);\n");
360 
		    output("    z_ = PTR_vec_ptr(x_);\n");
361 
		    output("    COPY_%TM(z_, READ_%TI());\n", s, s);
362 
		    break;
2 7u83 363 
		}
364 
	    }
365 
 
366 
	    /* Function trailer */
6 7u83 367 
	    output("    return(x_);\n");
368 
	    output("}\n\n");
369 
	    output("#endif\n\n\n", t);
2 7u83 370 
	}
371 
    }
372 
 
6 7u83 373 
    close_file();
374 
    return;
2 7u83 375 
}
376 
 
377 
 
378 
/*
6 7u83 379 
 * OUTPUT ENUMERATION WRITING ROUTINE
380 
 *
381 
 * This routine outputs code for writing an enumeration type to disk.
382 
 * This is done in two sections for long enumeration types.
383 
 */
2 7u83 384 
 
6 7u83 385 
static void
386 
disk_write_enum(void)
2 7u83 387 
{
6 7u83 388 
    number n = log2(DEREF_number(en_order(CRT_ENUM)));
389 
    if (n <= 16) {
390 
	output("    WRITE_BITS(%n, (unsigned)x_);\n", n);
2 7u83 391 
    } else {
6 7u83 392 
	n -= 16;
393 
	output("    WRITE_BITS(16, (unsigned)(x_ & 0xffff));\n");
394 
	output("    WRITE_BITS(%n, (unsigned)(x_ >> 16));\n", n);
2 7u83 395 
    }
6 7u83 396 
    return;
2 7u83 397 
}
398 
 
399 
 
400 
/*
6 7u83 401 
 * OUTPUT STRUCTURE WRITING ROUTINE
402 
 *
403 
 * This routine outputs code for writing a structure type to disk.
404 
 */
2 7u83 405 
 
6 7u83 406 
static void
407 
disk_write_struct(void)
2 7u83 408 
{
409 
    LOOP_STRUCTURE_COMPONENT {
6 7u83 410 
	TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
411 
	output("    WRITE_%TI(x_.%CN);\n", t);
2 7u83 412 
    }
6 7u83 413 
    return;
2 7u83 414 
}
415 
 
416 
 
417 
/*
6 7u83 418 
 * OUTPUT UNION WRITING ROUTINE
419 
 *
420 
 * This routine outputs code for writing a union type to disk.
421 
 */
2 7u83 422 
 
6 7u83 423 
static void
424 
disk_write_union(void)
2 7u83 425 
{
6 7u83 426 
    int have_ucmp = 0;
427 
    output("    if (IS_NULL_%UM(x_)) {\n");
428 
    output("\tWRITE_BITS(1, (unsigned)0);\n");
429 
    output("    } else {\n");
2 7u83 430 
    LOOP_UNION_COMPONENT {
6 7u83 431 
	output("\t%CT %CN;\n");
432 
	have_ucmp = 1;
2 7u83 433 
    }
6 7u83 434 
    output("\tunsigned tag_ = TAG_%UM(x_);\n");
435 
    output("\tWRITE_BITS(1, (unsigned)1);\n");
436 
    output("\tWRITE_BITS(%UO2, tag_);\n");
437 
    output("\tswitch (tag_) {\n");
2 7u83 438 
    LOOP_UNION_FIELD {
6 7u83 439 
	int have_cmp = have_ucmp;
440 
	int al = DEREF_int(fld_flag(CRT_FIELD));
441 
	output("\t    case %UM_%FN_tag: {\n");
2 7u83 442 
	LOOP_FIELD_COMPONENT {
6 7u83 443 
	    output("\t\t%CT %CN;\n");
444 
	    have_cmp = 1;
2 7u83 445 
	}
446 
 
447 
	/* Deal with aliasing */
6 7u83 448 
	if (al) {
449 
	    output("\t\tunsigned alias_ = GET_ALIAS_%UM_%FN(x_);\n");
450 
	    output("\t\tif (alias_) {\n");
451 
	    output("\t\t    WRITE_ALIAS(alias_);\n");
452 
	    output("\t\t    WRITE_BITS(1, (unsigned)0);\n");
453 
	    output("\t\t    break;\n");
454 
	    output("\t\t}\n");
455 
	    output("\t\talias_ = ++crt_%X_alias;\n");
456 
	    output("\t\tSET_ALIAS_%UM_%FN(x_, alias_);\n");
457 
	    output("\t\tWRITE_ALIAS(alias_);\n");
458 
	    output("\t\tWRITE_BITS(1, (unsigned)1);\n");
2 7u83 459 
	}
6 7u83 460 
 
2 7u83 461 
	/* Deconstruct union */
6 7u83 462 
	if (have_cmp) {
463 
	    output("\t\tDECONS_%UM_%FN(");
464 
	    LOOP_UNION_COMPONENT output("%CN, ");
465 
	    LOOP_FIELD_COMPONENT output("%CN, ");
466 
	    output(" x_);\n");
2 7u83 467 
	}
468 
 
469 
	/* Process further if necessary */
6 7u83 470 
	if (al == 2) {
471 
	    output("\t\tALIAS_%UM_%FN(");
472 
	    LOOP_UNION_COMPONENT output("%CN, ");
473 
	    LOOP_FIELD_COMPONENT output("%CN, ");
474 
	    output(" x_);\n");
2 7u83 475 
	}
476 
 
477 
	/* Write out components */
478 
	LOOP_UNION_COMPONENT {
6 7u83 479 
	    TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
480 
	    output("\t\tWRITE_%TI(%CN);\n", t);
2 7u83 481 
	}
482 
	LOOP_FIELD_COMPONENT {
6 7u83 483 
	    TYPE_P t = DEREF_ptr(cmp_type(CRT_COMPONENT));
484 
	    output("\t\tWRITE_%TI(%CN);\n", t);
2 7u83 485 
	}
6 7u83 486 
	output("\t\tbreak;\n");
487 
	output("\t    }\n");
2 7u83 488 
    }
6 7u83 489 
    output("\t}\n");
490 
    output("    }\n");
491 
    return;
2 7u83 492 
}
493 
 
494 
 
495 
/*
6 7u83 496 
 * PRINT THE DISK WRITING DEFINITIONS
497 
 *
498 
 * This routine outputs all the routines for writing the various types
499 
 * to disk.
500 
 */
2 7u83 501 
 
6 7u83 502 
static void
503 
disk_write_def(char *dir)
2 7u83 504 
{
6 7u83 505 
    open_file(dir, WRITE_PREFIX, DEF_SUFFIX);
506 
    print_include();
2 7u83 507 
 
6 7u83 508 
    comment("Disk writing function declarations");
2 7u83 509 
    LOOP_TYPE {
6 7u83 510 
	TYPE_P t = CRT_TYPE;
511 
	TYPE t0 = DEREF_type(t);
512 
	unsigned tag = TAG_type(t0);
513 
	if (is_identity_type(t)) {
514 
	    output("#ifndef WRITE_%TI\n", t);
515 
	    output("#define WRITE_%TI(A) WRITE_%TJ(A)\n", t, t);
516 
	    output("#endif\n\n");
517 
	} else if (tag != type_primitive_tag) {
518 
	    output("#ifndef WRITE_%TI\n", t);
519 
	    output("static void WRITE_%TI(%TT);\n", t, t);
520 
	    output("#endif\n\n");
2 7u83 521 
	}
522 
    }
6 7u83 523 
    output("\n");
2 7u83 524 
 
525 
    /* Function definitions */
526 
    LOOP_TYPE {
6 7u83 527 
	TYPE_P t = CRT_TYPE;
528 
	TYPE t0 = DEREF_type(t);
529 
	unsigned tag = TAG_type(t0);
530 
	if (!is_identity_type(t) && tag != type_primitive_tag) {
2 7u83 531 
	    /* Function header */
6 7u83 532 
	    output ("/* Disk writing routine for %TT */\n\n", t );
533 
	    output("#ifndef WRITE_%TI\n\n", t);
534 
	    output("static void WRITE_%TI\n", t);
535 
	    output("\n");
536 
	    output("(%TT x_)\n", t);
537 
	    output("{\n");
2 7u83 538 
 
539 
	    /* Function body */
6 7u83 540 
	    switch (tag) {
2 7u83 541 
 
6 7u83 542 
		case type_enumeration_tag: {
543 
		    ENUM_P p = DEREF_ptr(type_enumeration_en(t0));
2 7u83 544 
		    LOOP_ENUM {
6 7u83 545 
			if (EQ_ptr(CRT_ENUM, p)) {
546 
			    disk_write_enum();
547 
			    break;
2 7u83 548 
			}
549 
		    }
6 7u83 550 
		    break;
2 7u83 551 
		}
552 
 
6 7u83 553 
		case type_structure_tag: {
554 
		    STRUCTURE_P p = DEREF_ptr(type_structure_struc(t0));
2 7u83 555 
		    LOOP_STRUCTURE {
6 7u83 556 
			if (EQ_ptr(CRT_STRUCTURE, p)) {
557 
			    disk_write_struct();
558 
			    break;
2 7u83 559 
			}
560 
		    }
6 7u83 561 
		    break;
2 7u83 562 
		}
563 
 
6 7u83 564 
		case type_onion_tag: {
565 
		    UNION_P p = DEREF_ptr(type_onion_un(t0));
2 7u83 566 
		    LOOP_UNION {
6 7u83 567 
			if (EQ_ptr(CRT_UNION, p)) {
568 
			    disk_write_union();
569 
			    break;
2 7u83 570 
			}
571 
		    }
6 7u83 572 
		    break;
2 7u83 573 
		}
574 
 
6 7u83 575 
		case type_ptr_tag: {
576 
		    TYPE_P s = DEREF_ptr(type_ptr_sub(t0));
577 
		    output("    if (IS_NULL_ptr(x_)) {\n");
578 
		    output("\tWRITE_BITS(1, (unsigned)0);\n");
579 
		    output("    } else {\n");
580 
		    output("\t%TT y_;\n\t", s);
581 
		    print_deref(s, "x_", "y_");
582 
		    output("\tWRITE_BITS(1, (unsigned)1);\n");
583 
		    output("\tWRITE_%TI(y_);\n", s);
584 
		    output("    }\n");
585 
		    break;
2 7u83 586 
		}
587 
 
6 7u83 588 
		case type_list_tag: {
589 
		    TYPE_P s = DEREF_ptr(type_list_sub(t0));
590 
		    output("    while (!IS_NULL_list(x_)) {\n");
591 
		    output("\t%TT y_;\n\t", s);
592 
		    print_deref(s, "HEAD_list(x_)", "y_");
593 
		    output("\tWRITE_BITS(1, (unsigned)1);\n");
594 
		    output("\tWRITE_%TI(y_);\n", s);
595 
		    output("\tx_ = TAIL_list(x_);\n");
596 
		    output("    }\n");
597 
		    output("    WRITE_BITS(1, (unsigned)0);\n");
598 
		    break;
2 7u83 599 
		}
600 
 
6 7u83 601 
		case type_stack_tag: {
602 
		    TYPE_P s = DEREF_ptr(type_stack_sub(t0));
603 
		    output("    LIST(%TT) w_ = LIST_stack(x_);\n", s);
604 
		    output("    while (!IS_NULL_list(w_)) {\n");
605 
		    output("\t%TT y_;\n\t", s);
606 
		    print_deref(s, "HEAD_list(w_)", "y_");
607 
		    output("\tWRITE_BITS(1, (unsigned)1);\n");
608 
		    output("\tWRITE_%TI(y_);\n", s);
609 
		    output("\tw_ = TAIL_list(w_);\n");
610 
		    output("    }\n");
611 
		    output("    WRITE_BITS(1, (unsigned)0);\n");
612 
		    break;
2 7u83 613 
		}
614 
 
6 7u83 615 
		case type_vec_tag: {
616 
		    TYPE_P s = DEREF_ptr(type_vec_sub(t0));
617 
		    output("    %X_dim n_ = DIM_vec(x_);\n");
618 
		    output("    PTR(%TT)y_ ", s);
619 
		    output(" = PTR_vec_ptr(VEC_PTR_vec(x_));\n");
620 
		    output("    WRITE_DIM((unsigned)n_);\n");
621 
		    output("    while (n_--) {\n");
622 
		    output("\t%TT z_;\n\t", s);
623 
		    print_deref(s, "y_", "z_");
624 
		    output("\tWRITE_%TI(z_);\n", s);
625 
		    output("\ty_ = STEP_ptr(y_, %TS);\n", s);
626 
		    output("    }\n");
627 
		    break;
2 7u83 628 
		}
629 
 
6 7u83 630 
		case type_vec_ptr_tag: {
631 
		    TYPE_P s = DEREF_ptr(type_vec_ptr_sub(t0));
632 
		    output("    PTR(%TT)y_ = PTR_vec_ptr(x_);\n", s);
633 
		    output("    %TT z_;\n    ", s);
634 
		    print_deref(s, "y_", "z_");
635 
		    output("    WRITE_%TI(z_);\n", s);
636 
		    break;
2 7u83 637 
		}
638 
	    }
639 
 
640 
	    /* Function trailer */
6 7u83 641 
	    output("    return;\n");
642 
	    output("}\n\n");
643 
	    output("#endif\n\n\n");
2 7u83 644 
	}
645 
    }
6 7u83 646 
    close_file();
647 
    return;
2 7u83 648 
}
649 
 
650 
 
651 
/*
6 7u83 652 
 * MAIN DISK ACTION
653 
 *
654 
 * This routine prints all the output files for reading and writing the
655 
 * calculus to disk.
656 
 */
2 7u83 657 
 
6 7u83 658 
void
659 
disk_action(char *dir)
2 7u83 660 
{
6 7u83 661 
    disk_read_def(dir);
662 
    disk_write_def(dir);
663 
    return;
2 7u83 664 
}