/* %Z%%M% %I% %E% */

/*
 * Copyright (c) 1992, 1993, 1994, 1995, 2000 by Wayne C. Gramlich.
 * All rights reserved.
 *
 * Permission to use, copy, modify, distribute, and sell this software
 * for any purpose is hereby granted without fee provided that the above
 * copyright notice and this permission are retained.  The author makes
 * no representations about the suitability of this software for any purpose.
 * It is provided "as is" without express or implied warranty.
 */

/*
 * This file contains code for generating the STIPPLE routine declarations
 * for generate clauses:
 */

#ifndef FLAGS_DEFS_H
#include "flags_defs.h"
#endif

#ifndef GENERATE_DEFS_H
#include "generate_defs.h"
#endif

#ifndef HEAP_EXPORTS_H
#include "heap_exports.h"
#endif

#ifndef LINT_H
#include "lint.h"
#endif

#ifndef MSG_EXPORTS_H
#include "msg_exports.h"
#endif

#ifndef OUT_EXPORTS_H
#include "out_exports.h"
#endif

#ifndef PARSER_DEFS_H
#include "parser_defs.h"
#endif

#ifndef STR_EXPORTS_H
#include "str_exports.h"
#endif

#ifndef TYPE_DEFS_H
#include "type_defs.h"
#endif

#ifndef VECTOR_DEFS_H
#include "vector_defs.h"
#endif

#ifndef UNIX_ASSERT_H
#include "unix_assert.h"
#endif

#ifndef UNIX_UNISTD_H
#include "unix_unistd.h"
#endif

LOCAL Stdio	generate_gen_file_open(Parser);

/*
 * generate_gen_file_open(parser)
 *	This routine will open a generate file from "parser".
 */
LOCAL Stdio
generate_gen_file_open(
	Parser		parser)
{
	Stdio		gen_file;

	gen_file = parser->gen_file;
	if (gen_file == (Stdio)0) {
		gen_file = fopen(parser->flags->gen_file->full, "w");
		parser->gen_file = gen_file;
	}
	return gen_file;
}

/*
 * routine_address_get_output(type_def, gen_file)
 *	This routine will output an address_get routine for "type_def"
 *	to "gen_file".
 */
LOCAL void
routine_address_get_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure address_get@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\tobject %r\n", 2, type_ref);
	out(gen_file, "%\treturns address\n", 1);
	out(gen_file, "%\texternal %s__address_get\n", 1, type_name);
	out(gen_file, "\n");
}

/*
 * routine_new_output(type_def, gen_file)
 *	This routine will output a new routine for "type_def" to "gen_file".
 */
LOCAL void
routine_allocate_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure allocate__helper@%r\n", type_ref);
	out(gen_file, "%\ttakes_nothing\n", 1);
	out(gen_file, "%\treturns %r\n", 1, type_ref);
	out(gen_file, "%\texternal %s__allocate__helper\n", 1, type_name);
	out(gen_file, "\n");

	out(gen_file, "procedure allocate@%r\n", type_ref);
	out(gen_file, "%\ttakes_nothing\n", 1);
	out(gen_file, "%\treturns %r\n", 1, type_ref);
	out(gen_file, "\n");
	out(gen_file, "%\tallocate:: %r := allocate__helper@%r()\n",
	    1, type_ref, type_ref);
	out(gen_file, "%\terase@(allocate)\n", 1);
	out(gen_file, "%\treturn allocate\n", 1);
	out(gen_file, "\n");
}

/*
 * routine_copy_output(type_def, gen_file)
 *	This routine will output an copy routine for "type_def" to "gen_file".
 */
LOCAL void
routine_copy_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Type_ref	parameter;
	Type_refs	parameters;
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure copy@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\theap heap\n", 2);
	out(gen_file, "%\treturns %r\n", 1, type_ref);

	if (type_ref_is_parameterized(type_def->type_ref)) {
		parameters = type_def->type_ref->parameters;
		out(gen_file, "%\tneeds\n", 1);
		TYPE_REFS_LOOP(parameters, parameter) {
			out(gen_file, "%\tprocedure copy@%r\n", 2, parameter);
			out(gen_file, "%\ttakes %r, heap\n", 3, parameter);
			out(gen_file, "%\treturns %r\n", 3, parameter);
		}
	}
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
		out(gen_file, "%\treturn %s1\n", 1, type_name);
		break;
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;

		out(gen_file, "%\t%s2:: %r := new@%r(heap)\n",
		    1, type_name, type_ref, type_ref);
		fields = type_def->value.record->fields;
		VEC_LOOP(Type_field, fields, field) {
			field_name = field->name;
			out(gen_file, "%\t%s2.%s := copy@(%s1.%s, heap)\n",
			    1, type_name, field_name, type_name, field_name);
		}
		out(gen_file, "%\treturn %s2\n", 1, type_name);
		break;
	      }
	    case Type_kind_variant:
		assert_fail();
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_equal_output(type_def, gen_file)
 *	This routine will output an equal routine for "type_def" to "gen_file".
 */
LOCAL void
routine_equal_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Type_ref	parameter;
	Type_refs	parameters;
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure equal@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\t%s2 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\treturns logical\n", 1);

	if (type_ref_is_parameterized(type_def->type_ref)) {
		parameters = type_def->type_ref->parameters;
		out(gen_file, "%\tneeds\n", 1);
		TYPE_REFS_LOOP(parameters, parameter) {
			out(gen_file, "%\tprocedure equal@%r\n", 2, parameter);
			out(gen_file, "%\ttakes %r, %r\n",
			    3, parameter, parameter);
			out(gen_file, "%\treturns logical\n", 3);
		}
	}

	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		out(gen_file, "%\texternal %s__equal\n", 1, type_name);
		break;
	      }
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;
		int		index;
		int		size;

		out(gen_file, "\n");
		fields = type_def->value.record->fields;
		size = vec_size(Type_field, fields);
		for (index = 0; index < size; index++) {
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			if (index == 0) {
				out(gen_file, "%\treturn ", 1);
			} else {
				out(gen_file, "%\t", 2);
			}
			out(gen_file, "%s1.%s = %s2.%s",
			    type_name, field_name, type_name, field_name);
			if (index < size - 1) {
				out(gen_file, " &&");
			}
			out(gen_file, "\n");
		}
		break;
	      }
	    case Type_kind_variant:
		assert_fail();
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_erase_output(type_def, gen_file)
 *	This routine will output an erase routine for "type_def" to "gen_file".
 */
LOCAL void
routine_erase_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure erase@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
	out(gen_file, "%\treturns_nothing\n", 1);

	switch (type_def->kind) {
	    case Type_kind_enumeration:
		assert_fail();
		break;
	    case Type_kind_record:
	      {
		Type_field	field;
		Type_fields	fields;

		out(gen_file, "\n");
		fields = type_def->value.record->fields;
		VEC_LOOP(Type_field, fields, field) {
			out(gen_file, "%\t%s.%s := ??\n",
			    1, type_name, field->name);
		}
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Type_fields	fields;

		out(gen_file, "\n");
		fields = type_def->value.record->fields;
		assert(!vec_empty(Type_field, fields));
		field = vec_fetch(Type_field, fields, 0);
		out(gen_file, "%\t%s.%s := ??\n", 1, type_name, field->name);
		break;
	      }
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_hash_output(type_def, gen_file)
 *	This routine will output a hash routine for "type_def" to "gen_file".
 */
LOCAL void
routine_hash_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Type_ref	parameter;
	Type_refs	parameters;
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure hash@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %s\n", 2, type_name, type_name);
	out(gen_file, "%\treturns unsigned\n", 1);

	if (type_ref_is_parameterized(type_def->type_ref)) {
		parameters = type_def->type_ref->parameters;
		out(gen_file, "%\tneeds\n", 1);
		TYPE_REFS_LOOP(parameters, parameter) {
			out(gen_file, "%\tprocedure hash@%r\n", 2, parameter);
			out(gen_file, "%\ttakes %r\n", 3, parameter);
			out(gen_file, "%\treturns unsigned\n", 3);
		}
	}
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		out(gen_file, "%\treturn unsigned_convert@(%s1)\n",
		    1, type_name);
		break;
	      }
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;
		int		index;
		int		size;

		fields = type_def->value.record->fields;
		size = vec_size(Type_field, fields);
		for (index = 0; index < size; index++) {
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			if (index == 0) {
				out(gen_file, "%\treturn ", 1);
			} else {
				out(gen_file, "%\t", 2);
			}
			out(gen_file, "hash@(%s1.%s)", type_name, field_name);
			if (index < size - 1) {
				out(gen_file, " +");
			}
			out(gen_file, "\n");
		}
		break;
	      }
	    case Type_kind_variant:
		assert_fail();
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_identical_output(type_def, gen_file)
 *	This routine will output an equal routine for "type_def" to "gen_file".
 */
LOCAL void
routine_identical_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure identical@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\t%s2 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\treturns logical\n", 1);
	out(gen_file, "%\texternal %s__equal\n", 1, type_name);
	out(gen_file, "\n");
}

/*
 * routine_integer_convert_output(type_def, gen_file)
 *	This routine will output a integer_convert routine for "type_def"
 *	to "gen_file".
 */
LOCAL void
routine_integer_convert_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure integer_convert@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\treturns integer\n", 1);
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		Type_item	item;
		Str		item_name;
		Vec(Type_item)	items;
		int		index;
		int		size;

		out(gen_file, "%\tswitch %s1\n", 1, type_name);
		items = type_def->value.enumeration->items;
		size = vec_size(Type_item, items);
		for (index = 0; index < size; index++) {
			item = vec_fetch(Type_item, items, index);
			item_name = item->name;
			out(gen_file, "%\tcase %s\n", 2, item_name);
			out(gen_file, "%\treturn %d\n", 3, index);
		}
		break;
	      }
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_new_output(type_def, gen_file)
 *	This routine will output a new routine for "type_def" to "gen_file".
 */
LOCAL void
routine_new_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure new__helper@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\theap heap\n", 2);
	out(gen_file, "%\treturns %r\n", 1, type_ref);
	out(gen_file, "%\texternal %s__new__helper\n", 1, type_name);
	out(gen_file, "\n");

	out(gen_file, "procedure new@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\theap heap\n", 2);
	out(gen_file, "%\treturns %r\n", 1, type_ref);
	out(gen_file, "\n");
	out(gen_file, "%\tnew:: %r := new__helper@%r(heap)\n",
	    1, type_ref, type_ref);
	out(gen_file, "%\terase@(new)\n", 1);
	out(gen_file, "%\treturn new\n", 1);
	out(gen_file, "\n");
}

/*
 * routine_print_output(type_def, gen_file)
 *	This routine will output an print routine for "type_def" to "gen_file".
 */
LOCAL void
routine_print_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Type_ref	parameter;
	Type_refs	parameters;
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure print@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\tout_stream out_stream\n", 2);
	out(gen_file, "%\treturns_nothing\n", 1);

	if (type_ref_is_parameterized(type_def->type_ref)) {
		parameters = type_def->type_ref->parameters;
		out(gen_file, "%\tneeds\n", 1);
		TYPE_REFS_LOOP(parameters, parameter) {
			out(gen_file, "%\tprocedure print@%r\n", 2, parameter);
			out(gen_file,
			    "%\ttakes %r, out_stream\n", 3, parameter);
			out(gen_file, "%\treturns_nothing\n", 3);
		}
	}
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		Type_item	item;
		Str		item_name;
		Vec(Type_item)	items;

		out(gen_file, "%\tswitch %s1\n", 1, type_name);
		items = type_def->value.enumeration->items;
		VEC_LOOP(Type_item, items, item) {
			item_name = item->name;
			out(gen_file, "%\tcase %s\n", 2, item_name);
			out(gen_file, "%\tput@(\"%s\", out_stream)\n",
			    3, item_name);
		}
		break;
	      }
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;
		int		index;
		int		size;

		fields = type_def->value.record->fields;
		size = vec_size(Type_field, fields);
		for (index = 0; index < size; index++){
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			out(gen_file, "%\tput@(\"%s%s=\", out_stream)\n",
			    1, (index == 0) ? "{" : ", ", field_name);
			out(gen_file, "%\tprint@(%s1.%s, out_stream)\n",
			    1, type_name, field_name);
		}
		out(gen_file, "%\tput@(\"}\", out_stream)\n", 1);
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;

		out(gen_file, "%\textract %s1\n", 1, type_name);
		fields = type_def->value.record->fields;
		VEC_LOOP(Type_field, fields, field) {
			field_name = field->name;
			out(gen_file, "%\ttag %s:: %r := %s\n", 2,
			    field_name, field->type_ref, field_name);
			out(gen_file, "%\tprint@(%s, out_stream)\n",
			    3, field_name);
		}
		break;
	      }
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_save_output(type_def, gen_file)
 *	This routine will output an copy routine for "type_def" to "gen_file".
 */
LOCAL void
routine_save_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Type_ref	parameter;
	Type_refs	parameters;
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure save@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\tobject %r\n", 2, type_ref);
	out(gen_file, "%\tsave save\n", 2);
	out(gen_file, "%\toffset unsigned\n", 2);
	out(gen_file, "%\treturns_nothing\n", 1);

	if (type_ref_is_parameterized(type_def->type_ref)) {
		parameters = type_def->type_ref->parameters;
		out(gen_file, "%\tneeds\n", 1);
		TYPE_REFS_LOOP(parameters, parameter) {
			out(gen_file, "%\tprocedure save@%r\n", 2, parameter);
			out(gen_file,
			    "%\ttakes %r, save, unsigned\n", 3, parameter);
			out(gen_file, "%\treturns_nothing\n", 3, parameter);
		}
	}
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
		out(gen_file,
		    "%\tsave@(unsigned_convert@(object), save, offset)\n", 1);
		break;
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_ref	field_type;
		Type_fields	fields;
		int		index;
		int		size;

		fields = type_def->value.record->fields;
		size = vec_size(Type_field, fields);
		out(gen_file, "%\trecord_offset :@= "
		    "read_write_lookup@(save, object.address)\n", 1);
		out(gen_file, "%\tif record_offset = 0\n", 1);
		out(gen_file, "%\trecord_offset := "
		    "read_write_allocate@(save, object.address, %d)\n",
		    2, size);
		for (index = 0; index < size; index++) {
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			field_type = field->type_ref;
			if (type_ref_is_routine(field_type)) {
				out(gen_file,
				    "%\tprocedure@save1[%s](object.%s, save)\n",
				    2, "proc type", field_name);
			} else {
				out(gen_file, "%\tsave@(object.%s, save, "
				    	      "record_offset + %d)\n",
	 			    2, field_name, index);
			}
		}
		out(gen_file,
		    "%\tsave[offset] := read_write@(save, record_offset)\n", 1);
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Type_fields	fields;
		Str		field_name;
		Type_ref	field_type;
		int		index;
		int		size;
		Type_field	tag_field;
		Str		tag_field_name;
		Type_ref	tag_field_type;
		Type_variant	variant;

		out(gen_file, "%\tvariant_offset :@= "
		    "read_write_lookup@(save, object.address)\n", 1);
		out(gen_file, "%\tif variant_offset = 0\n", 1);
		out(gen_file, "%\tvariant_offset := "
		    "read_write_allocate@(save, object.address, 2)\n", 2);
		out(gen_file, "%\textract object\n", 2);

		variant = type_def->value.variant;
		tag_field = variant->tag_field;
		tag_field_name = tag_field->name;
		tag_field_type = tag_field->type_ref;
		fields = variant->fields;
		size = vec_size(Type_field, fields);
		for (index = 0; index < size; index++) {
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			field_type = field->type_ref;
			out(gen_file, "%\ttag tag_%d:: %r := %s\n",
			    3, index, field_type, field_name);
/*			out(gen_file, "%\tsave@(unsigned_convert@(%s@%r), "
			    "save, variant_offset + 0)\n",
			    4, field_name, tag_field_type); */
			if (type_ref_is_routine(field_type)) {
				out(gen_file,
				    "%\tprocedure@save1[%s](object.%s, save)\n",
				    4, "proc type", field_name);
			} else {
				out(gen_file, "%\tsave@(tag_%d, save, "
				    "variant_offset)\n", 4, index);
			}
			out(gen_file,
			    "%\tsave@(%d, save, variant_offset + 1)\n",
			    4, index);
		}
		out(gen_file, "%\tsave[offset] := "
		    "read_write@(save, variant_offset)\n", 1);
		break;
	      }
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * routine_unsigned_convert_output(type_def, gen_file)
 *	This routine will output a unsigned_convert routine for "type_def"
 *	to "gen_file".
 */
LOCAL void
routine_unsigned_convert_output(
	Type_def	type_def,
	Stdio		gen_file)
{
	Str		type_name;
	Type_ref	type_ref;

	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	out(gen_file, "procedure unsigned_convert@%r\n", type_ref);
	out(gen_file, "%\ttakes\n", 1);
	out(gen_file, "%\t%s1 %r\n", 2, type_name, type_ref);
	out(gen_file, "%\treturns unsigned\n", 1);
	out(gen_file, "\n");

	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		Type_item	item;
		Str		item_name;
		Vec(Type_item)	items;
		int		index;
		int		size;

		out(gen_file, "%\tswitch %s1\n", 1, type_name);
		items = type_def->value.enumeration->items;
		size = vec_size(Type_item, items);
		for (index = 0; index < size; index++) {
			item = vec_fetch(Type_item, items, index);
			item_name = item->name;
			out(gen_file, "%\tcase %s\n", 2, item_name);
			out(gen_file, "%\treturn %d\n", 3, index);
		}
		break;
	      }
	    default:
		assert_fail();
	}
	out(gen_file, "\n");
}

/*
 * generate_type_def_routine(type_def, generate, position, parser)
 *	Generate the STIPPLE code for each generate clause.
 */
void
generate_type_def_routine(
	Generate	generate,
	Type_def	type_def,
	int		position,
	Parser		parser)
{
	int		error;
	Stdio		gen_file;

	gen_file = generate_gen_file_open(parser);
	error = 0;
	switch (type_def->kind) {
	    case Type_kind_enumeration:
		switch (generate->kind) {
		    case Generate_address_get:
			error = 1;
		    case Generate_copy:
			break;
		    case Generate_equal:
			break;
		    case Generate_erase:
			error = 1;
			break;
		    case Generate_hash:
			break;
		    case Generate_integer_convert:
			break;
		    case Generate_identical:
			break;
		    case Generate_print:
			break;
		    case Generate_save:
			break;
		    case Generate_unsigned_convert:
			break;
		    default:
			assert_fail();
			break;
		}
		break;
	    case Type_kind_record:
		break;
	    case Type_kind_variant:
		break;
	    default:
		assert_fail();
	}
	if (error) {
		msg_out(parser->msg, position, "generate error");
	} else {
		switch (generate->kind) {
		    case Generate_address_get:
			routine_address_get_output(type_def, gen_file);
			break;
		    case Generate_allocate:
			routine_allocate_output(type_def, gen_file);
			break;
		    case Generate_copy:
			routine_copy_output(type_def, gen_file);
			break;
		    case Generate_equal:
			routine_equal_output(type_def, gen_file);
			break;
		    case Generate_erase:
			routine_erase_output(type_def, gen_file);
			break;
		    case Generate_hash:
			routine_hash_output(type_def, gen_file);
			break;
		    case Generate_identical:
			routine_identical_output(type_def, gen_file);
			break;
		    case Generate_integer_convert:
			routine_integer_convert_output(type_def, gen_file);
			break;
		    case Generate_new:
			routine_new_output(type_def, gen_file);
			break;
		    case Generate_print:
			routine_print_output(type_def, gen_file);
			break;
		    case Generate_save:
			routine_save_output(type_def, gen_file);
			break;
		    case Generate_unsigned_convert:
			routine_unsigned_convert_output(type_def, gen_file);
			break;
		    default:
			assert_fail();
		}
	}
}

/*
 * generate_type_def_routines(type_def, parser)
 */
void
generate_type_def_routines(
	Type_def	type_def,
	Parser		parser)
{
	Type_ref	type_ref;
	Str		type_name;
	Stdio		gen_file;

	gen_file = generate_gen_file_open(parser);
	type_ref = type_def->type_ref;
	type_name = type_ref->name;
	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		/*XXX: A bunch of object statements should be emitted here! */
		break;
	      }
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;

		fields = type_def->value.record->fields;
		VEC_LOOP(Type_field, fields, field) {
			field_name = field->name;
			out(gen_file, "procedure %s_get@%r\n",
			    field_name, type_ref);
			out(gen_file, "%\ttakes\n", 1);
			out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
			out(gen_file, "%\treturns %r\n", 1, field->type_ref);
			out(gen_file, "%\texternal %s__%s_get\n",
			    1, type_name, field_name);
			out(gen_file, "\n");

			out(gen_file, "procedure %s_set@%r\n",
			    field_name, type_ref);
			out(gen_file, "%\ttakes\n", 1);
			out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
			out(gen_file, "%\t%s %r\n",
			    2, field_name, field->type_ref);
			out(gen_file, "%\treturns_nothing\n", 1);
			out(gen_file, "%\texternal %s__%s_get\n",
			    1, type_name, field_name);
			out(gen_file, "\n");
		}
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;
		Type_variant	variant;

		/* Output the type get routine: */
		variant = type_def->value.variant;
		field = variant->tag_field;
		field_name = field->name;
		out(gen_file, "procedure %s_get@%r\n", field_name, type_ref);
		out(gen_file, "%\ttakes\n", 1);
		out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
		out(gen_file, "%\treturns %r\n", 1, field->type_ref);
		out(gen_file, "%\texternal %s__%s_get\n",
		    1, type_name, field_name);
		out(gen_file, "\n");

		fields = variant->fields;
		VEC_LOOP(Type_field, fields, field) {
			field_name = field->name;
			out(gen_file, "procedure %s_get@%r\n",
			    field_name, type_ref);
			out(gen_file, "%\ttakes\n", 1);
			out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
			out(gen_file, "%\treturns %r\n", 1, field->type_ref);
			out(gen_file, "%\texternal %s__%s_get\n",
			    1, type_name, field_name);
			out(gen_file, "\n");

			out(gen_file, "procedure %s_set@%r\n",
			    field_name, type_ref);
			out(gen_file, "%\ttakes\n", 1);
			out(gen_file, "%\t%s %r\n", 2, type_name, type_ref);
			out(gen_file, "%\t%s %r\n",
			    2, field_name, field->type_ref);
			out(gen_file, "%\treturns_nothing\n", 1);
			out(gen_file, "%\texternal %s__%s_set\n",
			    1, type_name, field_name);
			out(gen_file, "\n");
		}
		break;
	      }
	    case Type_kind_external:
		break;
	    default:
		assert_fail();
	}
}