WebSVN – tendra.SVN – Diff – /trunk/src/installers/common/diag/diag_fns.c

+/*
+ * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ * 3. Neither the name of The TenDRA Project nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific, prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $Id$
+ */
 /*
     		 Crown Copyright (c) 1997
     This TenDRA(r) Computer Program is subject to Copyright
     owned by the United Kingdom Secretary of State for Defence
 diag_tq f_dummy_diag_tq;
 filename f_dummy_filename;
 sourcemark f_dummy_sourcemark;
-#define DEBUG(x) x
+#define DEBUG(x)	x
 static dg_filename primary_file = (dg_filename)0;
 static nat zero_nat;
-static dg_tag
-	dg_tag_void_star,
-	dg_tag_signed_char, dg_tag_unsigned_char,
+static dg_tag dg_tag_void_star, dg_tag_signed_char, dg_tag_unsigned_char,
-	dg_tag_short, dg_tag_unsigned_short,
+	      dg_tag_short, dg_tag_unsigned_short, dg_tag_int,
-	dg_tag_int, dg_tag_unsigned_int,
-	dg_tag_long_long, dg_tag_unsigned_long_long,
+	      dg_tag_unsigned_int, dg_tag_long_long, dg_tag_unsigned_long_long,
-	dg_tag_float, dg_tag_double, dg_tag_long_double,
+	      dg_tag_float, dg_tag_double, dg_tag_long_double, dg_tag_complex,
-	dg_tag_complex, dg_tag_double_complex, dg_tag_long_double_complex;
+	      dg_tag_double_complex, dg_tag_long_double_complex;
 extern shape shcomplexsh;
 extern shape complexsh;
 extern shape complexdoublesh;
-static dg_tag make_bastype
+static dg_tag
-    PROTO_N ( (s) )
-    PROTO_T ( char * s )
+make_bastype(char *s)
-{
-  dg_tag ans = (dgtag_struct *) xmalloc (sizeof(dgtag_struct));
-  init_dgtag (ans);
-  ans->outref.k = LAB_STR;
-  ans->outref.u.s = s;
-  return ans;
-}
-static int tags_initialised = 0;
-static void init_basic_diag_tags
-    PROTO_Z ()
-{
-  dg_tag_void_star		= make_bastype ("__D_void_star");
-  dg_tag_signed_char		= make_bastype ("__D_signed_char");
-  dg_tag_unsigned_char		= make_bastype ("__D_unsigned_char");
-  dg_tag_short			= make_bastype ("__D_short");
-  dg_tag_unsigned_short		= make_bastype ("__D_unsigned_short");
-  dg_tag_int			= make_bastype ("__D_int");
-  dg_tag_unsigned_int		= make_bastype ("__D_unsigned_int");
-  dg_tag_long_long		= make_bastype ("__D_long_long");
-  dg_tag_unsigned_long_long	= make_bastype ("__D_unsigned_long_long");
-  dg_tag_float			= make_bastype ("__D_float");
-  dg_tag_double			= make_bastype ("__D_double");
-  dg_tag_long_double		= make_bastype ("__D_long_double");
-  dg_tag_complex		= make_bastype ("__D_complex");
-  dg_tag_double_complex		= make_bastype ("__D_double_complex");
-  dg_tag_long_double_complex	= make_bastype ("__D_long double_complex");
-  tags_initialised = 1;
-}
-static shape basic_tag_shape
-    PROTO_N ( (t) )
-    PROTO_T ( dg_tag t )
-{
-  if (t == dg_tag_void_star)
-    return f_pointer (f_alignment (scharsh));
-  if (t == dg_tag_signed_char)
-    return scharsh;
-  if (t == dg_tag_unsigned_char)
-    return ucharsh;
-  if (t == dg_tag_short)
-    return swordsh;
-  if (t == dg_tag_unsigned_short)
-    return uwordsh;
-  if (t == dg_tag_int)
-    return slongsh;
-  if (t == dg_tag_unsigned_int)
-    return ulongsh;
-  if (t == dg_tag_long_long)
-    return s64sh;
-  if (t == dg_tag_unsigned_long_long)
-    return u64sh;
-  if (t == dg_tag_float)
-    return shrealsh;
-  if (t == dg_tag_double)
-    return realsh;
-  if (t == dg_tag_long_double)
-    return doublesh;
-  if (t == dg_tag_complex)
-    return shcomplexsh;
-  if (t == dg_tag_double_complex)
-    return complexsh;
-  if (t == dg_tag_long_double_complex)
-    return complexdoublesh;
-  failer ("unexpected bitfield type");
-  return slongsh;
-}
-/*----------------------- diagdef and diag_descriptor  lists ----------------*/
-void start_make_diagdef_unit
-    PROTO_N ( (toks, tags, als, diagtags) )
-    PROTO_T ( int toks X int tags X int als X int diagtags )
-{
-  int i;
-  if (!tags_initialised)
-    init_basic_diag_tags ();
-  unit_no_of_tokens = toks;
-  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
-                    sizeof(tok_define *));
-  for (i = 0; i < unit_no_of_tokens; ++i)
-    unit_ind_tokens[i] = (tok_define*)0;
-  unit_no_of_tags = tags;
-  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
-                    sizeof(dec *));
-  for (i = 0; i < unit_no_of_tags; ++i)
-    unit_ind_tags[i] = (dec*)0;
-  unit_no_of_als = als;
-  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
-                    sizeof(aldef *));
-  for (i = 0; i < unit_no_of_als; ++i)
-    unit_ind_als[i] = (aldef*)0;
-  unit_no_of_diagtags = diagtags;
-  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
-                    sizeof(diag_tagdef *));
-  for (i = 0; i < unit_no_of_diagtags; ++i)
-    unit_ind_diagtags[i] = (diag_tagdef *)0;
-  return;
-}
-void init_diag_unit
-    PROTO_Z ()
-{
-  return;
-}
-diag_unit f_build_diag_unit
-    PROTO_N ( (labels, descriptors) )
-    PROTO_T ( tdfint labels X diag_descriptor_list descriptors )
-{
-  UNUSED(labels); UNUSED(descriptors);
-  failer("f_build_diag_unit isn't really here");
-  exit(EXIT_FAILURE);
-}
-diag_type_unit f_build_diagtype_unit
-    PROTO_N ( (labels, descriptors) )
-    PROTO_T ( tdfint labels X diag_tagdef_list descriptors )
-{
-  UNUSED(labels); UNUSED(descriptors);
-  failer("f_build_diagtype_unit isn't really here");
-  exit(EXIT_FAILURE);
-}
-void f_make_diagdef_unit
-    PROTO_Z ()
-{
-  int i;
-  int j = 0;
-  int no_of_labels;
-  int was_within_diags;
-  for (i = 0; i < unit_no_of_tokens; ++i)
-  {
-    if (unit_ind_tokens[i] == (tok_define*)0)
-      unit_ind_tokens[i] = &unit_toktab[j++];
-  };
-  j = 0;
-  for (i = 0; i < unit_no_of_tags; ++i)
-  {
-    if (unit_ind_tags[i] == (dec*)0)
-      unit_ind_tags[i] = &unit_tagtab[j++];
-  };
-  j = 0;
-  for (i = 0; i < unit_no_of_als; ++i)
-  {
-    if (unit_ind_als[i] == (aldef*)0)
-      unit_ind_als[i] = &unit_altab[j++];
-  };
-  j=0;
-  for (i = 0; i < unit_no_of_diagtags; ++i)
-  {
-    if (unit_ind_diagtags[i] == (diag_tagdef *)0)
-      unit_ind_diagtags[i] = &unit_diag_tagdeftab[j++];
-  };
-  was_within_diags = within_diags;
-  within_diags = 1;
-  {
-    dg_compilation * comp_unit_ptr = &all_comp_units;
-    dg_compilation ans;
-    dg_name_list desc_list;
-    while (* comp_unit_ptr)
-      comp_unit_ptr = &(* comp_unit_ptr)->another;
-    primary_file = (dg_filename)0;
-    start_bytestream();
-    no_of_labels = small_dtdfint();
-    unit_no_of_labels = no_of_labels;
-    unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
-    desc_list = d_diag_descriptor_list();
-    end_bytestream();
-    if (!primary_file)
-      primary_file = get_filename ((long)0, "", "", "no_source_file");
-    (* comp_unit_ptr) = ans = (dg_compilation) xmalloc (sizeof (struct dg_comp_t));
-    ans->prim_file = primary_file;
-    ans->comp_deps = new_string_list (0);
-    ans->date = 0;
-    ans->language = 1;	/* assume ANSI C */
-    ans->id_case = 0;	/* case sensitive */
-    ans->producer = "TenDRA";
-    ans->comp_dir = get_filename ((long)0, "", "unknown directory", "");
-    ans->options = new_string_list (0);
-    ans->dn_list = desc_list;
-    ans->macros = new_dg_macro_list (0);
-    ans->another = (dg_compilation)0;
-  }
-  within_diags = was_within_diags;
-  return;
-}
-diag_descriptor f_diag_desc_id
-    PROTO_N ( (n, whence, acc, new_type) )
-    PROTO_T ( tdfstring n X sourcemark whence X exp acc X diag_type new_type )
-{
-  dg_idname nid;
-  if (brog(son(acc))->dec_u.dec_val.extnamed)
-    nid = f_dg_external_idname (n);
-  else
-    nid = f_dg_sourcestring_idname (n);
-  if (new_type->key == DGT_PROC && !isvar(son(acc)))
-    return f_dg_proc_name (
-	nid,
-	whence,
-	new_type,
-	yes_exp_option (diag_locate (acc)),
-	no_dg_accessibility_option,
-	no_dg_virtuality_option,
-	f_false,
-	no_dg_type_list_option,
-	no_dg_tag_option);
-  else
-    return f_dg_object_name (
-	nid,
-	whence,
-	new_type,
-	yes_exp_option (diag_locate (acc)),
-	no_dg_accessibility_option);
-}
-diag_descriptor f_diag_desc_struct
-    PROTO_N ( (n, whence, new_type) )
-    PROTO_T ( tdfstring n X sourcemark whence X diag_type new_type )
-{
-  UNUSED (n);
-  UNUSED (whence);
-  UNUSED (new_type);
-  failer ("diag_desc_struct is obsolete");
-  return f_dummy_diag_descriptor;
-}
-diag_descriptor f_diag_desc_typedef
-    PROTO_N ( (n, whence, new_type) )
-    PROTO_T ( tdfstring n X sourcemark whence X diag_type new_type )
+{
+	dg_tag ans = (dgtag_struct *)xmalloc(sizeof(dgtag_struct));
+	init_dgtag(ans);
+	ans->outref.k = LAB_STR;
+	ans->outref.u.s = s;
+	return ans;
+}
+static int tags_initialised = 0;
+static void
+init_basic_diag_tags(void)
+{
+	dg_tag_void_star	   = make_bastype("__D_void_star");
-  if (!new_type || (new_type->key == DGT_TAGGED &&
+	dg_tag_signed_char	   = make_bastype("__D_signed_char");
+	dg_tag_unsigned_char	   = make_bastype("__D_unsigned_char");
+	dg_tag_short		   = make_bastype("__D_short");
+	dg_tag_unsigned_short	   = make_bastype("__D_unsigned_short");
-		    new_type->data.t_tag->key == DGK_NONE))
+	dg_tag_int		   = make_bastype("__D_int");
+	dg_tag_unsigned_int	   = make_bastype("__D_unsigned_int");
+	dg_tag_long_long	   = make_bastype("__D_long_long");
+	dg_tag_unsigned_long_long  = make_bastype("__D_unsigned_long_long");
+	dg_tag_float		   = make_bastype("__D_float");
+	dg_tag_double		   = make_bastype("__D_double");
+	dg_tag_long_double	   = make_bastype("__D_long_double");
+	dg_tag_complex		   = make_bastype("__D_complex");
+	dg_tag_double_complex	   = make_bastype("__D_double_complex");
-    return (dg_name)0;		/* no type definition for __va_list etc */
+	dg_tag_long_double_complex = make_bastype("__D_long double_complex");
+	tags_initialised = 1;
+}
+static
+shape basic_tag_shape(dg_tag t)
+{
+	if (t == dg_tag_void_star) {
+		return f_pointer(f_alignment(scharsh));
+	}
+	if (t == dg_tag_signed_char) {
+		return scharsh;
+	}
+	if (t == dg_tag_unsigned_char) {
+		return ucharsh;
+	}
+	if (t == dg_tag_short) {
+		return swordsh;
+	}
+	if (t == dg_tag_unsigned_short) {
+		return uwordsh;
+	}
-  return f_dg_type_name (
+	if (t == dg_tag_int) {
+		return slongsh;
+	}
+	if (t == dg_tag_unsigned_int) {
+		return ulongsh;
+	}
-	f_dg_sourcestring_idname (n),
+	if (t == dg_tag_long_long) {
+		return s64sh;
+	}
+	if (t == dg_tag_unsigned_long_long) {
+		return u64sh;
+	}
+	if (t == dg_tag_float) {
+		return shrealsh;
+	}
+	if (t == dg_tag_double) {
+		return realsh;
+	}
+	if (t == dg_tag_long_double) {
+		return doublesh;
+	}
+	if (t == dg_tag_complex) {
+		return shcomplexsh;
+	}
+	if (t == dg_tag_double_complex) {
+		return complexsh;
+	}
+	if (t == dg_tag_long_double_complex) {
+		return complexdoublesh;
+	}
+	failer("unexpected bitfield type");
+	return slongsh;
+}
+/*----------------------- diagdef and diag_descriptor  lists ----------------*/
+void
+start_make_diagdef_unit(int toks, int tags, int als, int diagtags)
+{
-	whence,
+	int i;
+	if (!tags_initialised) {
-	no_dg_accessibility_option,
+		init_basic_diag_tags();
+	}
+	unit_no_of_tokens = toks;
+	unit_ind_tokens = (tok_define **)xcalloc(unit_no_of_tokens,
+						 sizeof(tok_define *));
+	for (i = 0; i < unit_no_of_tokens; ++i) {
-	yes_dg_type_option (new_type),
+		unit_ind_tokens[i] = (tok_define *)0;
+	}
+	unit_no_of_tags = tags;
+	unit_ind_tags = (dec **)xcalloc(unit_no_of_tags, sizeof(dec *));
+	for (i = 0; i < unit_no_of_tags; ++i) {
+		unit_ind_tags[i] = (dec *)0;
+	}
+	unit_no_of_als = als;
+	unit_ind_als = (aldef **)xcalloc(unit_no_of_als, sizeof(aldef *));
+	for (i = 0; i < unit_no_of_als; ++i) {
+		unit_ind_als[i] = (aldef *)0;
+	}
+	unit_no_of_diagtags = diagtags;
+	unit_ind_diagtags = (diag_tagdef **)xcalloc(unit_no_of_diagtags,
+						    sizeof(diag_tagdef *));
+	for (i = 0; i < unit_no_of_diagtags; ++i)
+		unit_ind_diagtags[i] = (diag_tagdef *)0;
-	f_false,
+	return;
+}
+void
-	no_bool_option,
+init_diag_unit(void)
+{
+	return;
+}
+diag_unit
+f_build_diag_unit(tdfint labels, diag_descriptor_list descriptors)
+{
+	UNUSED(labels);
-	no_dg_constraint_list_option);
+	UNUSED(descriptors);
+	failer("f_build_diag_unit isn't really here");
+	exit(EXIT_FAILURE);
+}
-void init_diag_descriptor
-    PROTO_Z ()
-{
-  return;
-}
-diag_descriptor_list new_diag_descriptor_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  return new_dg_name_list (n);
-}
-diag_descriptor_list add_diag_descriptor_list
-    PROTO_N ( (list, elem,index) )
-    PROTO_T ( diag_descriptor_list list X diag_descriptor elem X int index )
-{
-  if (!elem)		/* no type definition for __va_list etc */
-    return list;
-  return add_dg_name_list (list, elem, index);
-}
-/*---------------------------- diag_tq--------------------------*/
-diag_tq f_diag_tq_null = 0;
-diag_tq f_add_diag_const
-    PROTO_N ( (qual) )
-    PROTO_T ( diag_tq qual )
-{
-  return (qual | (1 << DG_CONST_T));
-}
-diag_tq f_add_diag_volatile
-    PROTO_N ( (qual) )
-    PROTO_T ( diag_tq qual )
-{
-  return (qual | (1 << DG_VOL_T));
-}
-/*--------------------------diag_type -----------------------------*/
-diag_type f_diag_type_null = (dg_type)0;
-diag_type f_diag_type_apply_token
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
-{
-   tokval v;
-   v = apply_tok(token_value, token_args,  DIAG_TYPE_SORT, (tokval*)0);
-   return v.tk_diag_type;
-}
-diag_type f_diag_array
-    PROTO_N ( (element_type, stride, lower_bound, upper_bound, index_type) )
-    PROTO_T ( diag_type element_type X exp stride X exp lower_bound X exp upper_bound X diag_type index_type )
-{
-  return f_dg_array_type (
-	element_type,
-	stride,
-	no_bool_option,
-	add_dg_dim_list (new_dg_dim_list (1),
-		f_dg_bounds_dim (
-			f_dg_static_bound (lower_bound),
-			f_dg_static_bound (upper_bound),
-			index_type),
-));
-}
-diag_type f_diag_bitfield
-    PROTO_N ( (typ, number_of_bits) )
-    PROTO_T ( diag_type typ X nat number_of_bits )
-{
-  shape sha;
-  if (typ->key == DGT_BASIC)
-    sha = typ->data.t_bas.b_sh;
-  else
-  if (typ->key == DGT_ENUM)
-    sha = typ->data.t_enum.sha;
-  else
-  if (typ->key == DGT_TAGGED && typ->data.t_tag->outref.k == LAB_STR)
-    sha = basic_tag_shape (typ->data.t_tag);
-  else {
-    failer ("unexpected bitfield type");
-    sha = slongsh;
-  }
-  return f_dg_bitfield_type (
-	typ,
-	f_bfvar_bits (((name(sha) & 1) ? 1 : 0), number_of_bits),
-	sha);
-}
-diag_type f_diag_enum
-    PROTO_N ( (base_type, enum_name, values) )
-    PROTO_T ( diag_type base_type X tdfstring enum_name X enum_values_list values )
-{
-  UNUSED (base_type);
-  return f_dg_enum_type (
-	values,
-	yes_dg_idname_option (f_dg_sourcestring_idname (enum_name)),
-	no_dg_sourcepos_option,
-	sh(son(values.array->value)),
-	f_false);
-}
-diag_type f_diag_floating_variety
-    PROTO_N ( (var) )
-    PROTO_T ( floating_variety var )
-{
-  switch (var) {
-    case shrealfv:
-      return (f_dg_named_type (dg_tag_float));
-    case realfv:
-      return (f_dg_named_type (dg_tag_double));
-    case doublefv:
-      return (f_dg_named_type (dg_tag_long_double));
-    case shcomplexfv:
-      return (f_dg_named_type (dg_tag_complex));
-    case complexfv:
-      return (f_dg_named_type (dg_tag_double_complex));
-    case complexdoublefv:
-      return (f_dg_named_type (dg_tag_long_double_complex));
-  }
-  failer ("bad variety");
-  return f_dummy_diag_type;
-}
-diag_type f_diag_loc
-    PROTO_N ( (object, qualifier) )
-    PROTO_T ( diag_type object X diag_tq qualifier )
-{
-  if (qualifier & (1 << DG_CONST_T))
-    object = f_dg_qualified_type (DG_CONST_T, object);
-  if (qualifier & (1 << DG_VOL_T))
-    object = f_dg_qualified_type (DG_VOL_T, object);
-  return object;
-}
-diag_type f_diag_proc
-    PROTO_N ( (params, optional_args, result_type) )
-    PROTO_T ( diag_type_list params X bool optional_args X diag_type result_type )
-{
-  int i;
-  dg_param_list plist;
-  dg_param thispar;
-  procprops_option prps = no_procprops_option;
-  if (params.len == 1 && !params.array[0])
-    params.len = 0;
-  plist = new_dg_param_list (params.len);
-  for (i=0; i<params.len; i++) {
-    if (!params.array[i])
-      failer ("dummy parameter?");
-    thispar = f_dg_object_param (
-	no_dg_idname_option,
-	no_dg_sourcepos_option,
-	no_dg_param_mode_option,
-	params.array[i],
-	no_dg_default_option);
-    plist = add_dg_param_list (plist, thispar, i);
-  }
-  if (optional_args)
-    prps = yes_procprops_option (f_var_callers);
-  return f_dg_proc_type (plist, result_type, no_bool_option,
-	no_nat_option, no_nat_option, prps);
-}
-diag_type f_diag_ptr
-    PROTO_N ( (object, qualifier) )
-    PROTO_T ( diag_type object X diag_tq qualifier )
-{
-  dg_type ptr = (object ? f_dg_pointer_type (object, no_bool_option)
-			: f_dg_named_type (dg_tag_void_star));
-  return f_diag_loc (ptr, qualifier);
-}
-diag_type f_diag_struct
-    PROTO_N ( (tdf_shape, n, fields) )
-    PROTO_T ( shape tdf_shape X tdfstring n X diag_field_list fields )
-{
-  return f_dg_struct_type (
-	fields,
-	yes_shape_option (tdf_shape),
-	yes_dg_idname_option (f_dg_sourcestring_idname (n)),
-	no_dg_sourcepos_option,
-	no_dg_varpart_option,
-	f_false,
-	f_false);
-}
-diag_type f_diag_union
-    PROTO_N ( (tdf_shape, n, fields) )
-    PROTO_T ( shape tdf_shape X tdfstring n X diag_field_list fields )
-{
-  return f_dg_struct_type (
-	fields,
-	yes_shape_option (tdf_shape),
-	yes_dg_idname_option (f_dg_sourcestring_idname (n)),
-	no_dg_sourcepos_option,
-	no_dg_varpart_option,
-	f_true,
-	f_false);
-}
-diag_type f_diag_variety
-    PROTO_N ( (var) )
-    PROTO_T ( variety var )
-{
-  switch (name(var)) {
-    case scharhd:
-      return (f_dg_named_type (dg_tag_signed_char));
-    case ucharhd:
-      return (f_dg_named_type (dg_tag_unsigned_char));
-    case swordhd:
-      return (f_dg_named_type (dg_tag_short));
-    case uwordhd:
-      return (f_dg_named_type (dg_tag_unsigned_short));
-    case slonghd:
-      return (f_dg_named_type (dg_tag_int));
-    case ulonghd:
-      return (f_dg_named_type (dg_tag_unsigned_int));
-    case s64hd:
-      return (f_dg_named_type (dg_tag_long_long));
-    case u64hd:
-      return (f_dg_named_type (dg_tag_unsigned_long_long));
-  }
-  failer ("bad variety");
-  return f_dummy_diag_type;
-}
-void init_diag_type
-    PROTO_Z ()
-{
-  zero_nat.nat_val.small_nat = 0;
-  zero_nat.issmall = 1;
-  return;
-}
-/*-------------------------- DIAG TYPE HELPERS ---------------------*/
-/*---------------------------enum_values ---------------------------*/
-enum_values f_make_enum_values
-    PROTO_N ( (value, n) )
-    PROTO_T ( exp value X tdfstring n )
-{
-  return f_make_dg_enum (
-	value,
-	f_dg_sourcestring_idname (n),
-	f_dg_null_sourcepos);
-}
-void init_enum_values
-    PROTO_Z ()
-{
-  return;
-}
-enum_values_list new_enum_values_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  return new_dg_enum_list (n);
-}
-enum_values_list add_enum_values_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( enum_values_list list X enum_values elem X int index )
-{
-  return add_dg_enum_list (list, elem, index);
-}
-/*--------------------------struct fields-------------------------*/
-diag_field f_make_diag_field
+diag_type_unit
-    PROTO_N ( (field_name, wh, field_type) )
-    PROTO_T ( tdfstring field_name X exp wh X diag_type field_type )
+f_build_diagtype_unit(tdfint labels, diag_tagdef_list descriptors)
-{
-  return f_dg_field_classmem (
-	f_dg_sourcestring_idname (field_name),
-	f_dg_null_sourcepos,
-	wh,
-	field_type,
-	no_dg_accessibility_option,
-	no_bool_option,
-	no_dg_default_option);
-}
-void init_diag_field
-    PROTO_Z ()
+{
+	UNUSED(labels);
-  return;
+	UNUSED(descriptors);
+	failer("f_build_diagtype_unit isn't really here");
+	exit(EXIT_FAILURE);
+}
-diag_field_list new_diag_field_list
-    PROTO_N ( (n) )
+void
-    PROTO_T ( int n )
+f_make_diagdef_unit(void)
+{
+	int i;
+	int j = 0;
+	int no_of_labels;
+	int was_within_diags;
+	for (i = 0; i < unit_no_of_tokens; ++i) {
+		if (unit_ind_tokens[i] == (tok_define *)0) {
+			unit_ind_tokens[i] = &unit_toktab[j++];
+		}
+	}
+	j = 0;
+	for (i = 0; i < unit_no_of_tags; ++i) {
+		if (unit_ind_tags[i] == (dec *)0) {
+			unit_ind_tags[i] = &unit_tagtab[j++];
+		}
+	}
+	j = 0;
+	for (i = 0; i < unit_no_of_als; ++i) {
+		if (unit_ind_als[i] == (aldef*)0) {
+			unit_ind_als[i] = &unit_altab[j++];
+		}
+	}
+	j=0;
+	for (i = 0; i < unit_no_of_diagtags; ++i) {
+		if (unit_ind_diagtags[i] == (diag_tagdef *)0) {
+			unit_ind_diagtags[i] = &unit_diag_tagdeftab[j++];
+		}
+	}
+	was_within_diags = within_diags;
+	within_diags = 1;
+	{
+		dg_compilation *comp_unit_ptr = &all_comp_units;
+		dg_compilation ans;
+		dg_name_list desc_list;
+		while (* comp_unit_ptr) {
+			comp_unit_ptr = &(* comp_unit_ptr)->another;
+		}
+		primary_file = (dg_filename)0;
+		start_bytestream();
+		no_of_labels = small_dtdfint();
+		unit_no_of_labels = no_of_labels;
+		unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
+		desc_list = d_diag_descriptor_list();
+		end_bytestream();
+		if (!primary_file) {
+			primary_file = get_filename((long)0, "", "",
+						    "no_source_file");
+		}
+		(*comp_unit_ptr) = ans =
+		    (dg_compilation)xmalloc(sizeof(struct dg_comp_t));
+		ans->prim_file = primary_file;
+		ans->comp_deps = new_string_list(0);
+		ans->date = 0;
+		ans->language = 1;	/* assume ANSI C */
+		ans->id_case = 0;	/* case sensitive */
+		ans->producer = "TenDRA";
+		ans->comp_dir = get_filename((long)0, "", "unknown directory",
+					     "");
+		ans->options = new_string_list(0);
+		ans->dn_list = desc_list;
-  return new_dg_classmem_list (n);
+		ans->macros = new_dg_macro_list(0);
+		ans->another = (dg_compilation)0;
+	}
+	within_diags = was_within_diags;
+	return;
+}
+diag_descriptor
+f_diag_desc_id(tdfstring n, sourcemark whence, exp acc, diag_type new_type)
+{
+	dg_idname nid;
+	if (brog(son(acc))->dec_u.dec_val.extnamed) {
+		nid = f_dg_external_idname(n);
+	} else {
+		nid = f_dg_sourcestring_idname(n);
+	}
+	if (new_type->key == DGT_PROC && !isvar(son(acc))) {
+		return f_dg_proc_name(nid, whence, new_type,
+				      yes_exp_option(diag_locate(acc)),
+				      no_dg_accessibility_option,
+				      no_dg_virtuality_option, f_false,
+				      no_dg_type_list_option,
+				      no_dg_tag_option);
+	} else {
+		return f_dg_object_name(nid, whence, new_type,
+					yes_exp_option(diag_locate(acc)),
+					no_dg_accessibility_option);
+	}
+}
+diag_descriptor
+f_diag_desc_struct(tdfstring n, sourcemark whence, diag_type new_type)
+{
+	UNUSED(n);
+	UNUSED(whence);
+	UNUSED(new_type);
+	failer("diag_desc_struct is obsolete");
-diag_field_list add_diag_field_list
+	return f_dummy_diag_descriptor;
+}
+diag_descriptor
+f_diag_desc_typedef(tdfstring n, sourcemark whence, diag_type new_type)
+{
+	if (!new_type ||
-    PROTO_N ( (list, elem, index) )
+	    (new_type->key == DGT_TAGGED &&
+	     new_type->data.t_tag->key == DGK_NONE)) {
+		/* no type definition for __va_list etc */
+		return (dg_name)0;
+	}
-    PROTO_T ( diag_field_list list X diag_field elem X int index )
+	return f_dg_type_name(f_dg_sourcestring_idname(n), whence,
+			      no_dg_accessibility_option,
+			      yes_dg_type_option(new_type), f_false,
+			      no_bool_option, no_dg_constraint_list_option);
+}
+void
+init_diag_descriptor(void)
+{
+	return;
+}
+diag_descriptor_list
+new_diag_descriptor_list(int n)
+{
+}
 #else
 	/* !NEWDIAGS */
 #if issparc
 #include "sparcdiags.h"
 #endif
 #if is68000
 #include "xdb_basics.h"
 #endif
 /* allocate space in this file */
 #define EXTERN_DIAG
 #include "diagglob.h"
-#define DEBUG(x) x
+#define DEBUG(x)	x
 /* VARIABLES */
 /* All variables initialised */
 diag_tq f_diag_tq_null;	/* no need to initialise. Not really used. */
 /* IDENTITIES */
 struct diag_type_t f_diag_type_null_obj = { DIAG_TYPE_NULL };
 diag_type f_diag_type_null = &f_diag_type_null_obj;
 /* PROCEDURES */
 /*----------------------- diagdef and diag_descriptor  lists ----------------*/
-void start_make_diagdef_unit
+void
-    PROTO_N ( (toks, tags, als, diagtags) )
-    PROTO_T ( int toks X int tags X int als X int diagtags )
+start_make_diagdef_unit(int toks, int tags, int als, int diagtags)
 {
-  int i;
+	int i;
-  unit_no_of_tokens = toks;
+	unit_no_of_tokens = toks;
-  unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,
+	unit_ind_tokens = (tok_define **)xcalloc(unit_no_of_tokens,
-                    sizeof(tok_define *));
+						 sizeof(tok_define *));
-  for (i = 0; i < unit_no_of_tokens; ++i)
+	for (i = 0; i < unit_no_of_tokens; ++i) {
-    unit_ind_tokens[i] = (tok_define*)0;
+		unit_ind_tokens[i] = (tok_define *)0;
+	}
+	unit_no_of_tags = tags;
+	unit_ind_tags = (dec **)xcalloc(unit_no_of_tags, sizeof(dec *));
+	for (i = 0; i < unit_no_of_tags; ++i) {
+		unit_ind_tags[i] = (dec *)0;
+	}
+	unit_no_of_als = als;
+	unit_ind_als = (aldef **)xcalloc(unit_no_of_als, sizeof(aldef *));
+	for (i = 0; i < unit_no_of_als; ++i) {
+		unit_ind_als[i] = (aldef *)0;
+	}
+	unit_no_of_diagtags = diagtags;
+	unit_ind_diagtags = (diag_tagdef **)xcalloc(unit_no_of_diagtags,
+						    sizeof(diag_tagdef *));
+	for (i = 0; i < unit_no_of_diagtags; ++i) {
+		unit_ind_diagtags[i] = (diag_tagdef *)0;
+	}
+	return;
+}
+void
+init_diag_unit(void)
+{
+	return;
+}
+diag_unit
+f_build_diag_unit(tdfint labels, diag_descriptor_list descriptors)
+{
+	UNUSED(labels);
+	UNUSED(descriptors);
+	failer("f_build_diag_unit isn't really here");
+	exit(EXIT_FAILURE);
+}
+diag_type_unit
+f_build_diagtype_unit(tdfint labels, diag_tagdef_list descriptors)
+{
+	UNUSED(labels);
+	UNUSED(descriptors);
+	failer("f_build_diagtype_unit isn't really here");
+	exit(EXIT_FAILURE);
+}
-  unit_no_of_tags = tags;
+void
-  unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,
-                    sizeof(dec *));
-  for (i = 0; i < unit_no_of_tags; ++i)
-    unit_ind_tags[i] = (dec*)0;
+f_make_diagdef_unit(void)
+{
-  unit_no_of_als = als;
+	int i;
-  unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,
-                    sizeof(aldef *));
-  for (i = 0; i < unit_no_of_als; ++i)
-    unit_ind_als[i] = (aldef*)0;
+	int j = 0;
-  unit_no_of_diagtags = diagtags;
+	int no_of_labels;
-  unit_ind_diagtags = (diag_tagdef * *)xcalloc(unit_no_of_diagtags,
-                    sizeof(diag_tagdef *));
-  for (i = 0; i < unit_no_of_diagtags; ++i)
-    unit_ind_diagtags[i] = (diag_tagdef *)0;
+	for (i = 0; i < unit_no_of_tokens; ++i) {
+		if (unit_ind_tokens[i] == (tok_define *)0)
+			unit_ind_tokens[i] = &unit_toktab[j++];
+	}
-  return;
+	j = 0;
+	for (i = 0; i < unit_no_of_tags; ++i) {
+		if (unit_ind_tags[i] == (dec *)0) {
+			unit_ind_tags[i] = &unit_tagtab[j++];
+		}
+	}
+	j = 0;
+	for (i = 0; i < unit_no_of_als; ++i) {
+		if (unit_ind_als[i] == (aldef *)0) {
+			unit_ind_als[i] = &unit_altab[j++];
+		}
+	}
+	j=0;
+	for (i = 0; i < unit_no_of_diagtags; ++i) {
+		if (unit_ind_diagtags[i] == (diag_tagdef *)0) {
+			unit_ind_diagtags[i] = &unit_diag_tagdeftab[j++];
+		}
-}
+	}
-void init_diag_unit
+	start_bytestream();
-    PROTO_Z ()
-{
-  return;
-}
-diag_unit f_build_diag_unit
+	no_of_labels = small_dtdfint();
-    PROTO_N ( (labels, descriptors) )
+	unit_no_of_labels = no_of_labels;
-    PROTO_T ( tdfint labels X diag_descriptor_list descriptors )
+	unit_labtab = (exp *)xcalloc(unit_no_of_labels, sizeof(exp));
-{
-  UNUSED(labels); UNUSED(descriptors);
+	unit_diagvar_tab = d_diag_descriptor_list();
-  failer("f_build_diag_unit isn't really here");
+	end_bytestream();
-  exit(EXIT_FAILURE);
+	OUTPUT_GLOBALS_TAB();
+	return;
+}
-diag_type_unit f_build_diagtype_unit
-    PROTO_N ( (labels, descriptors) )
-    PROTO_T ( tdfint labels X diag_tagdef_list descriptors )
-{
-  UNUSED(labels); UNUSED(descriptors);
-  failer("f_build_diagtype_unit isn't really here");
-  exit(EXIT_FAILURE);
-}
-void f_make_diagdef_unit
-    PROTO_Z ()
-{
-  int i;
-  int j = 0;
-  int no_of_labels;
-  for (i = 0; i < unit_no_of_tokens; ++i)
-  {
-    if (unit_ind_tokens[i] == (tok_define*)0)
-      unit_ind_tokens[i] = &unit_toktab[j++];
-  };
-  j = 0;
-  for (i = 0; i < unit_no_of_tags; ++i)
-  {
-    if (unit_ind_tags[i] == (dec*)0)
-      unit_ind_tags[i] = &unit_tagtab[j++];
-  };
-  j = 0;
-  for (i = 0; i < unit_no_of_als; ++i)
-  {
-    if (unit_ind_als[i] == (aldef*)0)
-      unit_ind_als[i] = &unit_altab[j++];
-  };
-  j=0;
-  for (i = 0; i < unit_no_of_diagtags; ++i)
-  {
-    if (unit_ind_diagtags[i] == (diag_tagdef *)0)
-      unit_ind_diagtags[i] = &unit_diag_tagdeftab[j++];
-  };
-  start_bytestream();
-  no_of_labels = small_dtdfint();
-  unit_no_of_labels = no_of_labels;
-  unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
-  unit_diagvar_tab = d_diag_descriptor_list();
-  end_bytestream();
-  OUTPUT_GLOBALS_TAB();
-  return;
-}
 /*---------------------- diag_descriptor fns --------------------*/
 				/* HACK attack */
 				/* since diag_descriptor are not a pointer
 				 type we cant set the diag_global field
 				 easily, so we CHEAT via a global */
-static diag_descriptor * last_diag_desc;
+static diag_descriptor *last_diag_desc;
-diag_descriptor f_diag_desc_id
+diag_descriptor
-    PROTO_N ( (n, whence, acc, new_type) )
-    PROTO_T ( tdfstring n X sourcemark whence X exp acc X diag_type new_type )
+f_diag_desc_id(tdfstring n, sourcemark whence, exp acc, diag_type new_type)
+{
-  diag_descriptor new;
+	diag_descriptor new;
-  if (name(acc) != name_tag)
+	if (name(acc) != name_tag) {
-    failer("No name in f_diag_desc_id");
+		failer("No name in f_diag_desc_id");
+	}
-  new.key	 	= DIAG_ID_KEY;
+	new.key	= DIAG_ID_KEY;
-  new.data.id.nme 	= n;
+	new.data.id.nme = n;
-  new.data.id.whence	= whence;
+	new.data.id.whence = whence;
-  new.data.id.access	= acc;
+	new.data.id.access = acc;
-  new.data.id.new_type	= new_type;
+	new.data.id.new_type = new_type;
-  brog(son(acc))->dec_u.dec_val.diag_info =
+	brog(son(acc))->dec_u.dec_val.diag_info =
-    NEW_DIAG_GLOBAL(last_diag_desc);
+	    NEW_DIAG_GLOBAL(last_diag_desc);
-  return new;
+	return new;
+}
+diag_descriptor
+f_diag_desc_struct(tdfstring n, sourcemark whence, diag_type new_type)
+{
-diag_descriptor f_diag_desc_struct
+	diag_descriptor new;
+	new.key = DIAG_STRUCT_KEY;
+	new.data.struc.nme = n;
+	new.data.struc.whence = whence;
-    PROTO_N ( (n, whence, new_type) )
+	new.data.struc.new_type = new_type;
+	return new;
+}
+diag_descriptor
-    PROTO_T ( tdfstring n X sourcemark whence X diag_type new_type )
+f_diag_desc_typedef(tdfstring n, sourcemark whence, diag_type new_type)
+{
+	diag_descriptor new;
+	new.key = DIAG_TYPEDEF_KEY;
+	new.data.typ.nme = n;
+	new.data.typ.whence = whence;
+	new.data.typ.new_type = new_type;
+	return new;
+}
+void
+init_diag_descriptor(void)
+{
+	return;
+}
+diag_descriptor_list
+new_diag_descriptor_list(int n)
+{
+	diag_descriptor_list new;
+	new.len = n;
+	new.lastused = 0;
+	new.array = (diag_descriptor *)xcalloc(n, sizeof(diag_descriptor));
+	last_diag_desc = new.array;
+	return new;
+}
+diag_descriptor_list
+add_diag_descriptor_list(diag_descriptor_list list, diag_descriptor elem,
+			 int index)
+{
-  diag_descriptor new;
-  new.key	 	= DIAG_STRUCT_KEY;
-  new.data.struc.nme 	= n;
-  new.data.struc.whence	= whence;
-  new.data.struc.new_type	= new_type;
-  return new;
-}
-diag_descriptor f_diag_desc_typedef
-    PROTO_N ( (n, whence, new_type) )
-    PROTO_T ( tdfstring n X sourcemark whence X diag_type new_type )
-{
-  diag_descriptor new;
-  new.key	 	= DIAG_TYPEDEF_KEY;
-  new.data.typ.nme 	= n;
-  new.data.typ.whence	= whence;
-  new.data.typ.new_type	= new_type;
-  return new;
-}
-void init_diag_descriptor
-    PROTO_Z ()
-{
-  return;
-}
-diag_descriptor_list new_diag_descriptor_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  diag_descriptor_list new;
-  new.len = n;
-  new.lastused = 0;
-  new.array = (diag_descriptor *) xcalloc(n,sizeof( diag_descriptor ));
-  last_diag_desc = new.array;
-  return new;
-}
-diag_descriptor_list add_diag_descriptor_list
-    PROTO_N ( (list, elem,index) )
-    PROTO_T ( diag_descriptor_list list X diag_descriptor elem X int index )
-{
-  UNUSED(index);
+	UNUSED(index);
-  last_diag_desc++;
+	last_diag_desc++;
-  list.array[list.lastused++] = elem;
+	list.array[list.lastused++] = elem;
-  return list;
+	return list;
+}
 /*---------------------------- diag_tq--------------------------*/
-diag_tq f_add_diag_const
-    PROTO_N ( (qual) )
-    PROTO_T ( diag_tq qual )
-{
-  diag_tq new;
+diag_tq
-  new = qual;
-  new.is_const = 1;
-  return new;
-}
-diag_tq f_add_diag_volatile
-    PROTO_N ( (qual) )
-    PROTO_T ( diag_tq qual )
+f_add_diag_const(diag_tq qual)
 {
-  diag_tq new;
+	diag_tq new;
-  new = qual;
+	new = qual;
-  new.is_volatile = 1;
+	new.is_const = 1;
-  return new;
-}
-/*--------------------------diag_type -----------------------------*/
-diag_type f_diag_type_apply_token
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
-{
-   tokval v;
-   v = apply_tok(token_value, token_args,  DIAG_TYPE_SORT, (tokval*)0);
-   return v.tk_diag_type;
-}
-#ifndef NULL
-#define NULL ((OUTPUT_REC)0)
-#endif
-diag_type f_diag_array
-    PROTO_N ( (element_type, stride, lower_bound, upper_bound, index_type) )
-    PROTO_T ( diag_type element_type X exp stride X exp lower_bound X exp upper_bound X diag_type index_type )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key	= DIAG_TYPE_ARRAY;
-  new->been_outed = 0;
-  new->data.array.element_type	= element_type;
-  new->data.array.stride	= stride;
-  new->data.array.lower_b	= lower_bound;
-  new->data.array.upper_b	= upper_bound;
-  new->data.array.index_type	= index_type;
-  return new;
-}
-diag_type f_diag_bitfield
-    PROTO_N ( (type, number_of_bits) )
-    PROTO_T ( diag_type type X nat number_of_bits )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key      = DIAG_TYPE_BITFIELD;
-  new->been_outed = 0;
-  new->data.bitfield.result_type	= type;
-  new->data.bitfield.no_of_bits		= number_of_bits;
-  return new;
-}
-diag_type f_diag_enum
-    PROTO_N ( (base_type, enum_name, values) )
-    PROTO_T ( diag_type base_type X tdfstring enum_name X enum_values_list values )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key      = DIAG_TYPE_ENUM;
-  new->been_outed = 0;
-  new->data.t_enum.base_type	= base_type;
-  new->data.t_enum.nme		= enum_name;
-  new->data.t_enum.values	= values;
-  return new;
+	return new;
-}
-diag_type f_diag_floating_variety
-    PROTO_N ( (var) )
-    PROTO_T ( floating_variety var )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key      = DIAG_TYPE_FLOAT;
-  new->been_outed = 0;
-  new->data.f_var	= var;
-  return new;
-}
-diag_type f_diag_loc
-    PROTO_N ( (object, qualifier) )
-    PROTO_T ( diag_type object X diag_tq qualifier )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key      = DIAG_TYPE_LOC;
-  new->been_outed = 0;
-  new->data.loc.object		= object;
-  new->data.loc.qualifier	= qualifier;
-  return new;
+}
-diag_type f_diag_proc
-    PROTO_N ( (params, optional_args, result_type) )
-    PROTO_T ( diag_type_list params X bool optional_args X diag_type result_type )
-{
-  diag_type new = (diag_type) xcalloc(1,sizeof(struct diag_type_t));
-  new->key      = DIAG_TYPE_PROC;
-  new->been_outed = 0;
+diag_tq
-  new->data.proc.params		= params;
+f_add_diag_volatile(diag_tq qual)
+{
+	diag_tq new;
-  new->data.proc.opt_args	= optional_args;
+	new = qual;
-  new->data.proc.result_type	= result_type;
+	new.is_volatile = 1;
+	return new;
+}
-  return new;
+/*--------------------------diag_type -----------------------------*/
-}
-diag_type f_diag_ptr
+diag_type
-    PROTO_N ( (object, qualifier) )
-    PROTO_T ( diag_type object X diag_tq qualifier )
+f_diag_type_apply_token(token token_value, bitstream token_args)
+{
 /*-------------------------- DIAG TYPE HELPERS ---------------------*/
 /*---------------------------enum_values ---------------------------*/
+enum_values
-enum_values f_make_enum_values
+f_make_enum_values(exp value, tdfstring n)
+{
+	enum_values new = (enum_values)xcalloc(1, sizeof(struct enum_values_t));
+	new->val = value;
+	new->nme = n;
+	return new;
+}
+void
-    PROTO_N ( (value, n) )
+init_enum_values(void)
+{
+	return;
+}
+enum_values_list
-    PROTO_T ( exp value X tdfstring n )
+new_enum_values_list(int n)
+{
+	enum_values_list new =
+	    (enum_values_list)xcalloc(1, sizeof(struct enum_values_list_t));
+	new->len = n;
+	new->lastused = 0;
+	new->array = (enum_values *)xcalloc(n, sizeof(enum_values));
+	return new;
+}
+enum_values_list
+add_enum_values_list(enum_values_list list, enum_values elem, int index)
+{
+	UNUSED(index);
+	list->array[list->lastused++] = elem;
+	return list;
+}
+/*--------------------------struct fields-------------------------*/
+diag_field
+f_make_diag_field(tdfstring field_name, exp wh, diag_type field_type)
+{
+	diag_field new = (diag_field)xcalloc(1, sizeof(struct diag_field_t));
+	new->field_name	= field_name;
+	new->where = wh;
+	new->field_type	= field_type;
+	return new;
+}
+void
+init_diag_field(void)
+{
+	return;
+}
+diag_field_list
+new_diag_field_list(int n)
+{
+	diag_field_list new =
+	    (diag_field_list)xcalloc(1, sizeof(struct diag_field_list_t));
+	new->len = n;
+	new->lastused = 0;
+	new->array = (diag_field *)xcalloc(n, sizeof(diag_field));
+	return new;
+}
+diag_field_list
+add_diag_field_list(diag_field_list list, diag_field elem, int index)
+{
+	UNUSED(index);
+	list->array[list->lastused++] = elem;
+	return list;
+}
+/*----------------------diag type list----------------------*/
+diag_type_list
+new_diag_type_list(int n)
+{
+	diag_type_list new =
-  enum_values new = (enum_values) xcalloc(1,sizeof(struct enum_values_t));
+	    (diag_type_list)xcalloc(1, sizeof(struct diag_type_list_t));
-  new->val	= value;
-  new->nme 	= n;
+	new->len = n;
+	new->lastused = 0;
+	new->array = (diag_type *)xcalloc(n, sizeof(diag_type));
-  return new;
+	return new;
+}
-void init_enum_values
+diag_type_list
-    PROTO_Z ()
+add_diag_type_list(diag_type_list list, diag_type elem, int index)
+{
+	UNUSED(index);
+	list->array[list->lastused++] = elem;
-  return;
+	return list;
+}
-enum_values_list new_enum_values_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  enum_values_list new = (enum_values_list)
-    xcalloc(1,sizeof(struct enum_values_list_t));
-  new->len = n;
-  new->lastused = 0;
-  new->array = (enum_values *) xcalloc(n,sizeof( enum_values ));
-  return new;
-}
-enum_values_list add_enum_values_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( enum_values_list list X enum_values elem X int index )
-{
-  UNUSED(index);
-  list->array[list->lastused++] = elem;
-  return list;
-}
-/*--------------------------struct fields-------------------------*/
+/*----------------------------END HELPERS------------------------------------*/
-diag_field f_make_diag_field
-    PROTO_N ( (field_name, wh, field_type) )
-    PROTO_T ( tdfstring field_name X exp wh X diag_type field_type )
-{
-  diag_field new = (diag_field) xcalloc(1,sizeof(struct diag_field_t));
-  new->field_name	= field_name;
-  new->where		= wh;
-  new->field_type	= field_type;
-  return new;
-}
-void init_diag_field
-    PROTO_Z ()
-{
-  return;
-}
-diag_field_list new_diag_field_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  diag_field_list new = (diag_field_list)
-    xcalloc(1,sizeof(struct diag_field_list_t));
-  new->len = n;
-  new->lastused = 0;
-  new->array = (diag_field*) xcalloc(n,sizeof( diag_field));
-  return new;
-}
-diag_field_list add_diag_field_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( diag_field_list list X diag_field elem X int index )
-{
-  UNUSED(index);
-  list->array[list->lastused++] = elem;
-  return list;
-}
-/*----------------------diag type list----------------------*/
-diag_type_list new_diag_type_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  diag_type_list new = (diag_type_list)
-    xcalloc(1,sizeof(struct diag_type_list_t));
-  new->len = n;
-  new->lastused = 0;
-  new->array = (diag_type *) xcalloc(n,sizeof( diag_type ));
-  return new;
-}
-diag_type_list add_diag_type_list
-    PROTO_N ( (list, elem,index) )
-    PROTO_T ( diag_type_list list X diag_type elem X int index )
-{
-  UNUSED(index);
-  list->array[list->lastused++] = elem;
-  return list;
-}
-/*----------------------------END HELPERS------------------------------------*/
 /*-------------------------- sourcemark ---------------------------------*/
-sourcemark f_make_sourcemark
+sourcemark
-    PROTO_N ( (file, line_no, char_offset) )
-    PROTO_T ( filename file X nat line_no X nat char_offset )
+f_make_sourcemark(filename file, nat line_no, nat char_offset)
 {
-  sourcemark new;
+	sourcemark new;
-  new.file	= file;
+	new.file = file;
-  new.line_no	= line_no;
+	new.line_no = line_no;
-  new.char_off	= char_offset;
+	new.char_off = char_offset;
-  return new;
+	return new;
 }
+void
-void init_sourcemark
+init_sourcemark(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
 /*------------------------------filename ------------------------*/
-filename f_make_filename
+filename
-    PROTO_N ( (date, machine, file) )
-    PROTO_T ( nat date X tdfstring machine X tdfstring file )
+f_make_filename(nat date, tdfstring machine, tdfstring file)
 {
-  filename new;
+	filename new;
-  new 	= (filename) xcalloc(1,sizeof(struct filename_t));
+	new = (filename)xcalloc(1, sizeof(struct filename_t));
-  new->date 	= date;
+	new->date = date;
-  new->machine	= machine;
+	new->machine = machine;
-  new->file 	= file;
+	new->file  = file;
-  INSPECT_FILENAME(new);
+	INSPECT_FILENAME(new);
-  return new;
+	return new;
 }
-filename f_filename_apply_token
+filename
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
+f_filename_apply_token(token token_value, bitstream token_args)
 {
-   tokval v;
+	tokval v;
-   v = apply_tok(token_value, token_args, DIAG_FILENAME, (tokval*)0);
+	v = apply_tok(token_value, token_args, DIAG_FILENAME, (tokval *)0);
-   return v.tk_filename;
+	return v.tk_filename;
 }
 /*----------------------------- diag tag ------------------------------*/
+void
+init_diag_tag(void)
+{
+	return;
+}
-void init_diag_tag
+diag_tag
-    PROTO_Z ()
+f_make_diag_tag(tdfint num)
+{
-  return;
-}
-diag_tag f_make_diag_tag
-    PROTO_N ( (num) )
-    PROTO_T ( tdfint num )
-{
-  return num;
+	return num;
+}
 /*---------------------------- diag_tagdef =diag_typeunit ------------------*/
 diag_descriptor f_dummy_diag_descriptor;
 diag_tag f_dummy_diag_tag;
 diag_tagdef f_dummy_diag_tagdef;
 diag_type f_dummy_diag_type;
 diag_tq f_dummy_diag_tq;
 filename f_dummy_filename;
 sourcemark f_dummy_sourcemark;
-void init_diag_tq
-    PROTO_Z ()
-{
-  return;
-}
+void
-void init_filename
+init_diag_tq(void)
-    PROTO_Z ()
+{
-  return;
+	return;
+}
-void init_diag_type_unit
-    PROTO_Z ()
-{
-  return;
-}
+void
-void init_linkinfo_props
+init_filename(void)
+{
+	return;
+}
+void
+init_diag_type_unit(void)
+{
+	return;
+}
+void
-    PROTO_Z ()
+init_linkinfo_props(void)
+{
-  return;
+	return;
+}
 #endif

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/common/diag/diag_fns.c – Rev 2 → 7