/* %Z%%M% %I% %E% */ /* * Copyright (c) 1990, 1991, 1992, 1993, 1995 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. */ #ifndef FLAGS_DEFS_H #include "flags_defs.h" #endif #ifndef GEN_DEFS_H #include "gen_defs.h" #endif #ifndef GENERATE_EXPORTS_H #include "generate_exports.h" #endif #ifndef HEAP_EXPORTS_H #include "heap_exports.h" #endif #ifndef LINT_H #include "lint.h" #endif #ifndef ROUTINE_DEFS_H #include "routine_defs.h" #endif #ifndef STR_EXPORTS_H #include "str_exports.h" #endif #ifndef STRVEC_EXPORTS_H #include "strvec_exports.h" #endif #ifndef TABLE_EXPORTS_H #include "table_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_CTYPE_H #include "unix_ctype.h" #endif /* * type_translate(type_name, heap) * This routine will return the ANSI-C string type corresponding * to "type_name" allocated from "heap". */ Str type_translate( Str type_name, Heap heap) { /*XXX: This should depend on flags! */ if (strequal(type_name, "logical")) { return "int"; } else if (strequal(type_name, "character")) { return "unsigned"; } else if (strequal(type_name, "integer")) { return "int"; } else if (strequal(type_name, "unsigned")) { return "unsigned"; } else if (isdigit(type_name[0])) { return "void *"; } else { return strprintf(heap, "%s___type", type_name); } } /* * type_init_gen(type_ref, gen) * This routine will generate a reference to the initial object * for "type_ref" to "gen". */ void type_init_gen( Type_ref type_ref, Gen gen) { Str name; name = type_ref->name; /*XXX: Should depend upon the base types optimization flag. */ if (strequal(name, "logical")) { gen_out(gen, "0"); } else if (strequal(name, "character")) { gen_out(gen, "'\\0'"); } else if (strequal(name, "integer")) { gen_out(gen, "0"); } else if (strequal(name, "unsigned")) { gen_out(gen, "0"); } else if (type_ref_is_routine(type_ref)) { gen_out(gen, "((%T)run__time__uninitialized__routine)", name); } else if (type_ref_contains_parameter(type_ref)) { gen_out(gen, "((%s__%s__block__type *)_block_)->%m___initial", gen->routine->type_ref->name, gen->routine->name, type_ref); } else if (type_ref_is_parameterized(type_ref)) { gen_out(gen, "%s__%s__static.%m___initial", gen->routine->type_ref->name, gen->routine->name, type_ref); } else { gen_out(gen, "%I", name); } } /* * type_defs_routines_gen(type_defs, gen) * This routine will generate all of the accessor routines for "type_defs" * to "gen". */ void type_defs_routines_gen( Type_defs type_defs, Gen gen) { Type_def type_def; VEC_LOOP(Type_def, type_defs, type_def) { type_def_routines_gen(type_def, gen); } }