WebSVN – tendra.SVN – Diff – /trunk/src/installers/common/diag/dg_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
 $Date: 1998/03/11 11:03:30 $
 $Revision: 1.2 $
 $Log: dg_fns.c,v $
  * Revision 1.2  1998/03/11  11:03:30  pwe
  * DWARF optimisation info
  *
  * Revision 1.1.1.1  1998/01/17  15:55:46  release
  * First version to be checked into rolling release.
+ *
  * Revision 1.9  1998/01/11  18:44:53  pwe
  * consistent new/old diags
  * Revision 1.3  1997/10/23  09:21:04  pwe
  * ANDF-DE V1.7 and extra diags
+ *
  * Revision 1.2  1997/10/10  18:16:37  pwe
  * prep ANDF-DE revision
  *
  * Revision 1.1  1997/08/23  13:26:46  pwe
  * initial ANDF-DE
+ *
 ***********************************************************************/
 dg_filename all_files = (dg_filename)0;
 dg_compilation all_comp_units = (dg_compilation)0;
-string_list new_string_list
+string_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_string_list(int n)
+{
-  string_list ans;
+	string_list ans;
-  ans.len = n;
+	ans.len = n;
-  ans.array = (char **)xcalloc(n, sizeof(char *));
+	ans.array = (char **)xcalloc(n, sizeof(char *));
-  return ans;
+	return ans;
+}
-string_list add_string_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( string_list list X string elem X int index )
-{
-  list.array[index] = elem.ints.chars;
-  return list;
-}
-bool_option no_bool_option;
-bool_option yes_bool_option
-    PROTO_N ( (elem) )
-    PROTO_T ( bool elem )
-{
-  bool_option res;
-  res.val = elem;
-  res.present = 1;
-  return res;
-}
-void init_bool_option
-    PROTO_Z ()
-{
-  no_bool_option.present = 0;
-  return;
-}
-shape_option no_shape_option;
-shape_option yes_shape_option
-    PROTO_N ( (elem) )
-    PROTO_T ( shape elem )
-{
-  shape_option res;
-  res.val = elem;
-  res.present = 1;
-  return res;
-}
-void init_shape_option
-    PROTO_Z ()
-{
-  no_shape_option.present = 0;
-  return;
-}
-token_option no_token_option;
-token_option yes_token_option
-    PROTO_N ( (elem) )
+string_list
-    PROTO_T ( token elem )
+add_string_list(string_list list, string elem, int index)
+{
-  token_option res;
-  res.val = elem;
+	list.array[index] = elem.ints.chars;
-  res.present = 1;
-  return res;
+	return list;
+}
-void init_token_option
+bool_option no_bool_option;
-    PROTO_Z ()
+bool_option
+yes_bool_option(bool elem)
+{
+	bool_option res;
+	res.val = elem;
-  no_token_option.present = 0;
+	res.present = 1;
-  return;
+	return res;
+}
+void
-int unit_no_of_dgtags;
+init_bool_option(void)
-dgtag_struct ** unit_ind_dgtags;
-dgtag_struct * 	unit_dgtagtab;
-dg f_dg_apply_token
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
+{
+	no_bool_option.present = 0;
+	return;
+}
+shape_option no_shape_option;
+shape_option
+yes_shape_option(shape elem)
+{
+	shape_option res;
+	res.val = elem;
+	res.present = 1;
-   tokval v;
+	return res;
+}
+void
+init_shape_option(void)
+{
+	no_shape_option.present = 0;
+	return;
+}
+token_option no_token_option;
+token_option
-   v = apply_tok(token_value, token_args,  DG_SORT, (tokval*)0);
+yes_token_option(token elem)
+{
+	token_option res;
+	res.val = elem;
+	res.present = 1;
-   return v.tk_dg;
+	return res;
+}
+void
+init_token_option(void)
+{
+	no_token_option.present = 0;
+	return;
+}
-dg f_dummy_dg;
-dg f_make_tag_dg
-    PROTO_N ( (tg, diag) )
-    PROTO_T ( dg_tag tg X dg diag )
-{
-  if (tg->key) failer ("dg_tag defined twice");
-  tg->key = DGK_INFO;
-  tg->p.info = diag;
-  diag->this_tag = tg;
-  return diag;
-}
-dg f_list_dg
-    PROTO_N ( (args) )
-    PROTO_T ( dg_list args )
-{
-  return args;
-}
-dg f_params_dg
-    PROTO_N ( (params, outer_env) )
-    PROTO_T ( dg_name_list params X exp_option outer_env )
-{
-  dg ans = new_dg_info(DGA_PARAMS);
-  ans->data.i_param.args = params;
-  if (outer_env.present)
-    ans->data.i_param.o_env = diaginfo_exp (outer_env.val);
-  else
-    ans->data.i_param.o_env = nilexp;
-  ans->data.i_param.b_start = 0;
-  return ans;
-}
-dg f_source_language_dg
-    PROTO_N ( (language) )
-    PROTO_T ( nat language )
-{
-  dg ans = new_dg_info(DGA_COMP);
-  ans->data.i_comp.is_tag = 0;
-  ans->data.i_comp.corl.comp_lang = language.nat_val.small_nat;
-  return ans;
-}
-dg f_compilation_dg
-    PROTO_N ( (comp_unit) )
-    PROTO_T ( dg_tag comp_unit )
-{
-  dg ans = new_dg_info(DGA_COMP);
-  ans->data.i_comp.is_tag = 1;
-  ans->data.i_comp.corl.comp_tag = comp_unit;
-  return ans;
-}
-dg f_sourcepos_dg
-    PROTO_N ( (span) )
-    PROTO_T ( dg_sourcepos span )
-{
-  dg ans = new_dg_info(DGA_SRC);
-  ans->data.i_src.is_stmt = 0;
-  ans->data.i_src.startpos = shorten_sourcepos(span);
-  ans->data.i_src.endpos = end_sourcepos(span);
-  return ans;
-}
-dg f_name_decl_dg
-    PROTO_N ( (dname) )
-    PROTO_T ( dg_name dname )
-{
-  dg ans = new_dg_info(DGA_NAME);
-  ans->data.i_nam.dnam = dname;
-  return ans;
-}
-dg f_lexical_block_dg
-    PROTO_N ( (idname, src_pos) )
-    PROTO_T ( dg_idname_option idname X dg_sourcepos src_pos )
-{
-  dg ans = new_dg_info(DGA_SCOPE);
-  ans->data.i_scope.lexname = idname_chars(idname);
-  ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);
-  ans->data.i_scope.endpos = end_sourcepos(src_pos);
-  ans->data.i_scope.begin_st = (long)0;
-  return ans;
-}
-dg f_inline_call_dg
-    PROTO_N ( (proc, act_params, call_kind) )
-    PROTO_T ( dg_tag proc X dg_name_list act_params X nat_option call_kind )
-{
-  dg ans = new_dg_info(DGA_INL_CALL);
-  ans->data.i_inl.proc = proc;
-  ans->data.i_inl.args = act_params;
-  if (call_kind.present)
-    ans->data.i_inl.ck = call_kind.val.nat_val.small_nat;
-  else
-    ans->data.i_inl.ck = 0;
-  ans->data.i_inl.resref = nildiag;
-  proc->any_inl = 1;
-  return ans;
-}
-dg f_inline_result_dg
+int unit_no_of_dgtags;
-    PROTO_N ( (inline_id) )
-    PROTO_T ( dg_tag inline_id )
-{
-  dg ans = new_dg_info(DGA_INL_RES);
-  ans->data.i_res.call = inline_id;
-  ans->data.i_res.res.k = NO_WH;
-  ans->data.i_res.next = (dg_info)0;
-  return ans;
-}
-dg f_singlestep_dg
-    PROTO_N ( (src_pos) )
-    PROTO_T ( dg_sourcepos src_pos )
-{
-  dg ans = new_dg_info(DGA_SRC);
-  ans->data.i_src.is_stmt = 1;
-  ans->data.i_src.startpos = shorten_sourcepos(src_pos);
-  ans->data.i_src.endpos.file = 0;
-  return ans;
-}
-dg f_with_dg
-    PROTO_N ( (type, obtain_value) )
-    PROTO_T ( dg_type type X exp obtain_value )
-{
-  dg ans = new_dg_info(DGA_SRC);
-  ans->data.i_with.w_typ = type;
-  ans->data.i_with.w_exp = diaginfo_exp (obtain_value);
-  return ans;
-}
-dg f_exception_scope_dg
-    PROTO_N ( (handlers) )
-    PROTO_T ( dg_tag_list handlers )
-{
-  dg ans = new_dg_info(DGA_X_TRY);
-  ans->data.i_try.hl = handlers;
-  return ans;
-}
-dg f_exception_handler_dg
-    PROTO_N ( (ex) )
-    PROTO_T ( dg_name_option ex )
-{
-  dg ans = new_dg_info(DGA_X_CATCH);
-  ans->data.i_catch.ex = ex;
-  return ans;
-}
-dg f_abortable_part_dg
-    PROTO_N ( (src_pos, no_code) )
-    PROTO_T ( dg_sourcepos src_pos X bool no_code )
-{
-  dg ans = new_dg_info(DGA_RVS);
-  ans->data.i_rvs.rvs_key = DGR_ABTL;
-  ans->data.i_rvs.n_code = (no_code ? 0 : 2);
-  ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = 0;
-  ans->data.i_rvs.pos = shorten_sourcepos (src_pos);
-  ans->data.i_rvs.u.tg = (dg_tag)0;
-  ans->data.i_rvs.en = (dg_tag)0;
+dgtag_struct **unit_ind_dgtags;
-  return ans;
-}
-dg f_accept_dg
-    PROTO_N ( (src_pos, entry, params, no_code, alt) )
-    PROTO_T ( dg_sourcepos src_pos X dg_tag entry X dg_name_list params X
-	      bool no_code X dg_tag_option alt )
-{
-  dg ans = new_dg_info(DGA_RVS);
-  ans->data.i_rvs.rvs_key = DGR_ACC;
-  ans->data.i_rvs.n_code = (no_code ? 0 : 2);
-  ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = (alt ? 1 : 0);
-  ans->data.i_rvs.pos = shorten_sourcepos (src_pos);
-  ans->data.i_rvs.u.tg = alt;
-  ans->data.i_rvs.en = entry;
-  ans->data.i_rvs.u2.p = params;
-  return ans;
-}
-dg f_barrier_dg
-    PROTO_N ( (src_pos, entry) )
-    PROTO_T ( dg_sourcepos src_pos X dg_tag entry )
-{
-  dg ans = new_dg_info(DGA_BAR);
-  ans->data.i_bar.pos = shorten_sourcepos (src_pos);
-  ans->data.i_bar.entry = entry;
-  return ans;
-}
-dg f_branch_dg
-    PROTO_N ( (stmt_src_pos) )
-    PROTO_T ( dg_sourcepos stmt_src_pos )
-{
-  dg ans = new_dg_info(DGA_BRANCH);
-  ans->data.i_brn.pos = shorten_sourcepos(stmt_src_pos);
-  return ans;
-}
-dg f_call_dg
-    PROTO_N ( (idname, src_pos, call_kind, module, basetype) )
-    PROTO_T ( dg_idname_option idname X dg_sourcepos src_pos X
-	      nat_option call_kind X dg_tag_option module X
-	      dg_tag_option basetype )
-{
-  dg ans = new_dg_info(DGA_CALL);
-  ans->data.i_call.clnam = idname_chars (idname);
-  ans->data.i_call.pos = shorten_sourcepos(src_pos);
-  if (call_kind.present)
-    ans->data.i_call.ck = call_kind.val.nat_val.small_nat;
-  else
-    ans->data.i_call.ck = 0;
-  ans->data.i_call.p.k = NO_WH;
-  UNUSED (module);
-  UNUSED (basetype);
-  return ans;
-}
-dg f_destructor_dg
+dgtag_struct *unit_dgtagtab;
-    PROTO_N ( (whence, obtain_value) )
-    PROTO_T ( dg_sourcepos whence X exp_option obtain_value )
-{
-  dg ans = new_dg_info(DGA_DEST);
-  ans->data.i_dest.pos = shorten_sourcepos(whence);
-  if (obtain_value.present)
-    ans->data.i_dest.val = diaginfo_exp (obtain_value.val);
-  else
-    ans->data.i_dest.val = nilexp;
-  return ans;
-}
-dg f_inlined_dg
-    PROTO_N ( (d, origin) )
-    PROTO_T ( dg d X dg_tag origin )
-{
-  UNUSED (origin);
-	/* inlined_dg not yet supported */
-  return d;
-}
-dg f_jump_dg
-    PROTO_N ( (stmt_src_pos) )
-    PROTO_T ( dg_sourcepos stmt_src_pos )
-{
-  dg ans = new_dg_info(DGA_JUMP);
-  ans->data.i_tst.pos = shorten_sourcepos(stmt_src_pos);
-  return ans;
-}
-dg f_label_dg
-    PROTO_N ( (idname, src_pos) )
-    PROTO_T ( dg_idname idname X dg_sourcepos src_pos )
-{
-  dg ans = new_dg_info(DGA_LAB);
-  ans->data.i_scope.lexname = idname_chars(idname);
-  ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);
-  return ans;
-}
-dg f_long_jump_dg
-    PROTO_N ( (stmt_src_pos) )
-    PROTO_T ( dg_sourcepos stmt_src_pos )
-{
-  dg ans = new_dg_info(DGA_LJ);
-  ans->data.i_lj.pos = shorten_sourcepos(stmt_src_pos);
-  return ans;
-}
-dg f_raise_dg
-    PROTO_N ( (stmt_src_pos, ex, value) )
-    PROTO_T ( dg_sourcepos stmt_src_pos X dg_type_option ex X exp_option value )
-{
-  dg ans = new_dg_info(DGA_X_RAISE);
-  ans->data.i_raise.pos = shorten_sourcepos(stmt_src_pos);
-  ans->data.i_raise.x_typ = ex;
-  if (value.present)
-    ans->data.i_raise.x_val = diaginfo_exp (value.val);
-  else
-    ans->data.i_raise.x_val = nilexp;
-  return ans;
-}
-dg f_requeue_dg
-    PROTO_N ( (stmt_src_pos, entry, with_abort) )
-    PROTO_T ( dg_sourcepos stmt_src_pos X dg_tag entry X bool with_abort )
-{
-  dg ans = new_dg_info(DGA_RVS);
-  ans->data.i_rvs.rvs_key = DGR_REQUE;
-  ans->data.i_rvs.n_code = 2;
-  ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = 0;
-  ans->data.i_rvs.w_abort = with_abort;
-  ans->data.i_rvs.pos = shorten_sourcepos (stmt_src_pos);
-  ans->data.i_rvs.u.tg = (dg_tag)0;
-  ans->data.i_rvs.en = entry;
-  return ans;
-}
+{
-  dg ans = new_dg_info(DGA_RVS);
+	dg ans = new_dg_info(DGA_TEST);
-  ans->data.i_rvs.rvs_key = DGR_ALT;
-  ans->data.i_rvs.n_code = (no_code ? 0 : 2);
-  ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = 0;
-  ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;
-  ans->data.i_rvs.pos = shorten_sourcepos (src_pos);
+	ans->data.i_tst.pos = shorten_sourcepos(src_pos);
-  ans->data.i_rvs.u.tg = (dg_tag)0;
+	ans->data.i_tst.inv = inverted;
-  ans->data.i_rvs.u2.e = diaginfo_exp (alt_value);
-  return ans;
+	return ans;
+}
-dg f_select_guard_dg
+dg
-    PROTO_N ( (src_pos, alt) )
-    PROTO_T ( dg_sourcepos src_pos X dg_tag alt )
+f_triggering_alternative_dg(dg_sourcepos src_pos, nat alt_kind, bool no_code)
+{
-  dg ans = new_dg_info(DGA_RVS);
+	dg ans = new_dg_info(DGA_RVS);
-  ans->data.i_rvs.rvs_key = DGR_SGD;
+	ans->data.i_rvs.rvs_key = DGR_TRIG;
-  ans->data.i_rvs.n_code = 2;
+	ans->data.i_rvs.n_code = (no_code ? 0 : 2);
-  ans->data.i_rvs.has_iv = 0;
+	ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = (alt ? 1 : 0);
+	ans->data.i_rvs.alt = 0;
+	ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;
-  ans->data.i_rvs.pos = shorten_sourcepos (src_pos);
+	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
-  ans->data.i_rvs.u.tg = alt;
+	ans->data.i_rvs.u.tg = (dg_tag)0;
-  return ans;
+	return ans;
 }
-dg f_statement_part_dg
-    PROTO_N ( (lb) )
-    PROTO_T ( dg_tag lb )
-{
-  dg ans = new_dg_info(DGA_BEG);
-  ans->data.i_tg = lb;
-  return ans;
-}
-dg f_test_dg
-    PROTO_N ( (src_pos, inverted) )
-    PROTO_T ( dg_sourcepos src_pos X bool inverted )
-{
-  dg ans = new_dg_info(DGA_TEST);
-  ans->data.i_tst.pos = shorten_sourcepos (src_pos);
-  ans->data.i_tst.inv = inverted;
-  return ans;
-}
-dg f_triggering_alternative_dg
-    PROTO_N ( (src_pos, alt_kind, no_code) )
-    PROTO_T ( dg_sourcepos src_pos X nat alt_kind X bool no_code )
-{
-  dg ans = new_dg_info(DGA_RVS);
-  ans->data.i_rvs.rvs_key = DGR_TRIG;
-  ans->data.i_rvs.n_code = (no_code ? 0 : 2);
-  ans->data.i_rvs.has_iv = 0;
-  ans->data.i_rvs.alt = 0;
-  ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;
-  ans->data.i_rvs.pos = shorten_sourcepos (src_pos);
-  ans->data.i_rvs.u.tg = (dg_tag)0;
-  return ans;
-}
-void init_dg
+void
-    PROTO_Z ()
+init_dg(void)
-{
-  return;
-}
-dg_comp_props f_dummy_dg_comp_props;
-dg_comp_props f_make_dg_compunit
-    PROTO_N ( (no_labels, comp_unit, l) )
-    PROTO_T ( tdfint no_labels X dg_compilation comp_unit X dg_append_list l )
+{
-  UNUSED (no_labels);
-  UNUSED (comp_unit);
-  UNUSED (l);
+	return;
-  return f_dummy_dg_comp_props;	/* dummy, never called */
+}
-void init_dg_comp_props
+dg_comp_props f_dummy_dg_comp_props;
-    PROTO_Z ()
+dg_comp_props
+f_make_dg_compunit(tdfint no_labels, dg_compilation comp_unit, dg_append_list l)
+{
-  return;
-}
-dg_tag f_dummy_dg_tag;
+	UNUSED(no_labels);
-dg_tag f_make_dg_tag
+	UNUSED(comp_unit);
-    PROTO_N ( (num) )
+	UNUSED(l);
-    PROTO_T ( tdfint num )
-{
-  int index = natint(num);
-  if (index >= unit_no_of_dgtags)
-    failer("make_dg_tag out of range");
+	return f_dummy_dg_comp_props;	/* dummy, never called */
-  return unit_ind_dgtags[index];
-}
-void init_dg_tag
-    PROTO_Z ()
-{
-  return;
+}
+void
+init_dg_comp_props(void)
+{
+	return;
+}
+dg_tag f_dummy_dg_tag;
+dg_tag
+f_make_dg_tag(tdfint num)
+{
+	int index = natint(num);
+	if (index >= unit_no_of_dgtags) {
+		failer("make_dg_tag out of range");
+	}
+	return unit_ind_dgtags[index];
+}
+void
+init_dg_tag(void)
+{
+	return;
+}
 dg_name f_dummy_dg_name;
-dg_name f_dg_name_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,  DG_NAME_SORT, (tokval*)0);
-   return v.tk_dg_name;
-}
-dg_name f_dg_tag_name
-    PROTO_N ( (tg, nam) )
-    PROTO_T ( dg_tag tg X dg_name nam )
-{
-  if (tg->key) failer ("dg_tag defined twice");
-  tg->key = DGK_NAME;
-  tg->p.nam = nam;
-  if (!nam->mor)
-    extend_dg_name (nam);
-  nam->mor->this_tag = tg;
-  return nam;
-}
-dg_name f_dg_object_name
-    PROTO_N ( (idname, whence, type, obtain_value, accessibility) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X
-	      exp_option obtain_value X dg_accessibility_option accessibility )
-{
-  dg_name ans = new_dg_name(DGN_OBJECT);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_obj.typ = type;
-#ifdef NEWDIAGS
-  if (obtain_value.present) {
-    exp acc = obtain_value.val;
-    ans->data.n_obj.obtain_val = diaginfo_exp (acc);
-    set_obj_ref (ans);		/* globals only */
-#if 0
-    if (name(acc) == cont_tag && name(son(acc)) == name_tag &&
-		isglob(son(son(acc))) && isvar(son(son(acc))))
-      brog(son(son(acc)))->dec_u.dec_val.diag_info = ans;
-#endif
-  }
-  else
-    ans->data.n_obj.obtain_val = nilexp;
-#endif
-  if (accessibility != DG_ACC_NONE) {
-    extend_dg_name (ans);
-    ans->mor->acc = accessibility;
-  }
-  return ans;
-}
-dg_name f_dg_proc_name
-    PROTO_N ( (idname, whence, type, obtain_value, accessibility,
-		virtuality, isinline, exceptions, elaboration) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X
-	      exp_option obtain_value X dg_accessibility_option accessibility X
-	      dg_virtuality_option virtuality X bool isinline X
-	      dg_type_list_option exceptions X dg_tag_option elaboration )
-{
-  dg_name ans = new_dg_name(DGN_PROC);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_proc.typ = type;
-#ifdef NEWDIAGS
-  if (obtain_value.present) {
-    exp acc = obtain_value.val;
-    ans->data.n_proc.obtain_val = diaginfo_exp (acc);
-    if (name(acc) == name_tag && isglob(son(acc)))
-      brog(son(acc))->dec_u.dec_val.diag_info = ans;
-  }
-  else
-    ans->data.n_proc.obtain_val = nilexp;
-  ans->data.n_proc.params = (dg_info)0;
-  if (accessibility != DG_ACC_NONE || virtuality != DG_VIRT_NONE
-	|| isinline || extra_diags || elaboration || exceptions.len >= 0) {
-    extend_dg_name (ans);
-    ans->mor->acc = accessibility;
-    ans->mor->virt = virtuality;
-    ans->mor->isinline = isinline;
-    ans->mor->end_pos = end_sourcepos (whence);
-    ans->mor->elabn = elaboration;
-    ans->mor->exptns = exceptions;
-  }
-#endif
-  return ans;
-}
-dg_name f_dg_inlined_name
-    PROTO_N ( (nam, origin) )
-    PROTO_T ( dg_name nam X dg_tag origin )
-{
-  if (!nam->mor)
-    extend_dg_name (nam);
-  nam->mor->inline_ref = origin;
-  return nam;
-}
-dg_name f_dg_constant_name
-    PROTO_N ( (nam) )
-    PROTO_T ( dg_name nam )
-{
-  if (!nam->mor)
-    extend_dg_name (nam);
-  nam->mor->isconst = 1;
-  return nam;
-}
-dg_name f_dg_type_name
-    PROTO_N ( (idname, whence, accessibility, type, new_type,
-		ada_derived, constraints) )
-    PROTO_T ( dg_idname_option idname X dg_sourcepos whence X
-	      dg_accessibility_option accessibility X dg_type_option type X
-	      bool new_type X bool_option ada_derived X
-	      dg_constraint_list_option constraints )
-{
-  dg_name ans = new_dg_name(DGN_TYPE);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_typ.raw = type;
-  if (idname.id_key == DG_ID_NONE)
-    ans->data.n_typ.named = type;
-  else
+dg_name
-    ans->data.n_typ.named = (dg_type)0;
-  if (accessibility != DG_ACC_NONE || new_type ||
-	(ada_derived.present && ada_derived.val)) {
-    extend_dg_name (ans);
-    ans->mor->acc = accessibility;
-    ans->mor->isnew = new_type;
-    if (ada_derived.present)
-      ans->mor->aderiv = ada_derived.val;
-  }
-  ans->data.n_typ.constraints = constraints;
-  return ans;
-}
-dg_name f_dg_subunit_name
-    PROTO_N ( (parent, nam, subunit_kind, accessibility) )
-    PROTO_T ( dg_tag parent X dg_name nam X nat subunit_kind X dg_accessibility_option accessibility )
-{
-  dg_name ans = new_dg_name(DGN_SUBUNIT);
-  ans->data.n_sub.parent = parent;
-  ans->data.n_sub.sub = nam;
-  switch (subunit_kind.nat_val.small_nat) {
-    case 1:	/* SUK_child */
-      ans->data.n_sub.child = 1;
-      ans->data.n_sub.split = 0;
-      break;
-    case 2:	/* SUK_separate */
-      ans->data.n_sub.child = 0;
-      ans->data.n_sub.split = 0;
-      ans->data.n_sub.acc = accessibility;
-      break;
-    case 3:	/* SUK_split_module */
-      ans->data.n_sub.child = 0;
-      ans->data.n_sub.split = 1;
-      break;
-    default:
-      failer ("unexpected SUK_kind");
-  }
-  return ans;
-}
-dg_name f_dg_program_name
-    PROTO_N ( (idname, whence, obtain_value) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X exp obtain_value )
-{
-  dg_name ans = new_dg_name(DGN_PROC);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_proc.typ = (dg_type)0;
-  ans->data.n_proc.obtain_val = diaginfo_exp (obtain_value);
-  ans->data.n_proc.params = (dg_info)0;
-  extend_dg_name (ans);
-  ans->mor->prognm = 1;
-  return ans;
-}
-dg_name f_dg_entry_family_name
-    PROTO_N ( (proc, family) )
-    PROTO_T ( dg_name proc X dg_dim family )
-{
-  if (!proc->mor)
-    extend_dg_name (proc);
-  proc->mor->en_family = (dg_dim *)xmalloc (sizeof(dg_dim));
-  *(proc->mor->en_family) = family;
-  return proc;
-}
-dg_name f_dg_entry_name
-    PROTO_N ( (idname, whence, type, accessibility, family) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X
-	      dg_accessibility_option accessibility X dg_dim_option family )
-{
-  dg_name ans = new_dg_name(DGN_ENTRY);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_proc.typ = type;
-  if (accessibility != DG_ACC_NONE || family.d_key != DG_DIM_NONE) {
-    extend_dg_name (ans);
-    ans->mor->acc = accessibility;
-    if (family.d_key != DG_DIM_NONE) {
-      ans->mor->en_family = (dg_dim *)xmalloc (sizeof(dg_dim));
-      *(ans->mor->en_family) = family;
-    }
-  }
-  return ans;
-}
-dg_name f_dg_is_spec_name
-    PROTO_N ( (nam, is_separate) )
-    PROTO_T ( dg_name nam X bool_option is_separate )
-{
-  if (!nam->mor)
-    extend_dg_name (nam);
-  nam->mor->isspec = 1;
-  if (is_separate.present && is_separate.val)
-    nam->mor->issep = 1;
-  return nam;
-}
-dg_name f_dg_module_name
-    PROTO_N ( (idname, whence, memlist, init, elaboration) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_namelist memlist X
-	      exp_option init X dg_tag_option elaboration )
-{
-  dg_name ans = new_dg_name(DGN_MODULE);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_mod.members = memlist.list;
-#ifdef NEWDIAGS
-  if (memlist.tg)
-    memlist.tg->p.nl = &(ans->data.n_mod.members);
-  if (init.present) {
-    exp acc = init.val;
-    ans->data.n_mod.init = diaginfo_exp (acc);
-    if (name(acc) == name_tag && isglob(son(acc)))
-      brog(son(acc))->dec_u.dec_val.diag_info = ans;
-  }
-  else
-    ans->data.n_mod.init = nilexp;
-#endif
-  if (elaboration) {
-    extend_dg_name (ans);
-    ans->mor->elabn = elaboration;
-  }
-  return ans;
-}
-dg_name f_dg_namespace_name
-    PROTO_N ( (idname, whence, members) )
-    PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_namelist members )
-{
-  dg_name ans = new_dg_name(DGN_NSP);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (whence);
-  ans->data.n_mod.members = members.list;
-  if (members.tg)
-    members.tg->p.nl = &(ans->data.n_mod.members);
-  ans->data.n_mod.init = nilexp;
-  return ans;
-}
-dg_name f_dg_rep_clause_name
-    PROTO_N ( (item, location) )
-    PROTO_T ( dg_name item X exp location )
-{
-  if (!item->mor)
-    extend_dg_name (item);
-  item->mor->repn = diaginfo_exp (location);
-  return item;
-}
-dg_name f_dg_spec_ref_name
-    PROTO_N ( (specification, nam) )
-    PROTO_T ( dg_tag specification X dg_name nam )
-{
-  if (!nam->mor)
-    extend_dg_name (nam);
-  nam->mor->refspec = specification;
-  return nam;
-}
-dg_name f_dg_visibility_name
-    PROTO_N ( (dname, import_kind, idname, src_pos, accessibility, type) )
-    PROTO_T ( dg_tag dname X nat import_kind X dg_idname_option idname X
-	      dg_sourcepos_option src_pos X
-	      dg_accessibility_option accessibility X dg_type_option type )
-{
-  dg_name ans = new_dg_name(DGN_IMPORT);
-  ans->idnam = idname;
-  ans->whence = shorten_sourcepos (src_pos);
-  ans->data.n_imp.import = dname;
-  ans->data.n_imp.ik = import_kind.nat_val.small_nat;
-  if (accessibility != DG_ACC_NONE ) {
-    extend_dg_name (ans);
-    ans->mor->acc = accessibility;
-  }
-  ans->data.n_imp.i_typ = type;
-  return ans;
-}
-void init_dg_name
-    PROTO_Z ()
-{
-  return;
-}
-dg_type f_dummy_dg_type;
-dg_type f_dg_type_apply_token
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
+f_dg_name_apply_token(token token_value, bitstream token_args)
-{
-   tokval v;
-   v = apply_tok(token_value, token_args,  DG_TYPE_SORT, (tokval*)0);
-   return v.tk_dg_type;
-}
-dg_type f_dg_tag_type
-    PROTO_N ( (tg, type) )
-    PROTO_T ( dg_tag tg X dg_type type )
-{
-  if (tg->key && tg->key != DGK_TYPE) failer ("dg_tag defined twice");
-  tg->key = DGK_TYPE;
-  tg->p.typ = type;
-  return type;
-}
-dg_type f_dg_named_type
-    PROTO_N ( (dname) )
-    PROTO_T ( dg_tag dname )
-{
-  dg_type ans;
-  if (dname->key == DGK_TYPE)
-    return dname->p.typ;
-  if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE
-	&& dname->p.nam->data.n_typ.named)
-    return dname->p.nam->data.n_typ.named;
-  ans = new_dg_type(DGT_TAGGED);
-  ans->data.t_tag = dname;
-  if (dname->key == DGK_NONE && dname->outref.k == LAB_STR) {
-    dname->key = DGK_TYPE;
-    dname->p.typ = ans;
-    ans->outref = dname->outref;
-  }
-  else
-  if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE)
-    dname->p.nam->data.n_typ.named = ans;
-  return ans;
-}
-dg_type f_dg_is_spec_type
-    PROTO_N ( (type) )
-    PROTO_T ( dg_type type )
-{
-  if (!type->mor)
-    extend_dg_type (type);
-  type->mor->isspec = 1;
-  return type;
-}
-dg_type f_dg_spec_ref_type
-    PROTO_N ( (specification, type) )
-    PROTO_T ( dg_tag specification X dg_type type )
-{
-  if (!type->mor)
-    extend_dg_type (type);
-  type->mor->refspec = specification;
-  return type;
-}
-dg_type f_dg_modular_type
-    PROTO_N ( (rep_type, size) )
-    PROTO_T ( dg_type rep_type X exp size )
-{
-  dg_type ans = new_dg_type(DGT_MOD);
-  ans->data.t_adanum.rept = rep_type;
-  ans->data.t_adanum.digits = diaginfo_exp (size);
-  return ans;
-}
-dg_type f_dg_qualified_type
-    PROTO_N ( (qualifier, type) )
-    PROTO_T ( dg_qualifier qualifier X dg_type type )
-{
-  return get_qual_dg_type (qualifier, type);
-}
-dg_type f_dg_pointer_type
-    PROTO_N ( (type, heap_only) )
-    PROTO_T ( dg_type type X bool_option heap_only )
-{
-  if (heap_only.present && heap_only.val)
-    return get_qual_dg_type (DG_HPPTR_T, type);
-  return get_qual_dg_type (DG_PTR_T, type);
-}
-dg_type f_dg_reference_type
-    PROTO_N ( (type) )
-    PROTO_T ( dg_type type )
-{
-  return get_qual_dg_type (DG_REF_T, type);
-}
-dg_type f_dg_packed_type
-    PROTO_N ( (type, sha) )
-    PROTO_T ( dg_type type X shape sha )
-{
-  UNUSED (sha);
-  return get_qual_dg_type (DG_PACK_T, type);
-}
-dg_type f_dg_array_type
-    PROTO_N ( (element_type, stride, row_major, dimensions) )
-    PROTO_T ( dg_type element_type X exp stride X bool_option row_major X
-	      dg_dim_list dimensions )
-{
-  dg_type ans = new_dg_type(DGT_ARRAY);
-  ans->data.t_arr.elem_type = element_type;
-  ans->data.t_arr.stride = diaginfo_exp (stride);
-  ans->data.t_arr.rowm = (row_major.present ? row_major.val : 1);
-  ans->data.t_arr.dims = dimensions;
-  return ans;
-}
-dg_type f_dg_bitfield_type
-    PROTO_N ( (type, bv, sha) )
-    PROTO_T ( dg_type type X bitfield_variety bv X shape sha )
-{
-  return get_dg_bitfield_type (type, sha, bv);
-}
-dg_type f_dg_enum_type
-    PROTO_N ( (values, tagname, src_pos, sha, new_type) )
-    PROTO_T ( dg_enum_list values X dg_idname_option tagname X
-	      dg_sourcepos_option src_pos X shape sha X bool new_type )
-{
-  dg_type ans = new_dg_type(DGT_ENUM);
-  ans->data.t_enum.tnam = idname_chars (tagname);
-  ans->data.t_enum.tpos = shorten_sourcepos (src_pos);
-  ans->data.t_enum.values = values;
-  ans->data.t_enum.sha = sha;
-  if (new_type) {
-    extend_dg_type (ans);
-    ans->mor->isnew = new_type;
-  }
-  return ans;
-}
-dg_type f_dg_string_type
-    PROTO_N ( (character_type, lower_bound, length) )
-    PROTO_T ( dg_tag character_type X exp lower_bound X exp length )
+{
-  dg_type ans = new_dg_type(DGT_STRING);
+	tokval v;
-  ans->data.t_string.ct = character_type;
-  ans->data.t_string.lb = diaginfo_exp (lower_bound);
+	v = apply_tok(token_value, token_args, DG_NAME_SORT, (tokval *)0);
-  ans->data.t_string.length = diaginfo_exp (length);
-  return ans;
+	return v.tk_dg_name;
+}
+{
-  return;
+	return;
+}
-dg_class_base f_dummy_dg_class_base;
-dg_class_base f_make_dg_class_base
-    PROTO_N ( (base, whence, location, accessibility, virtuality) )
-    PROTO_T ( dg_tag base X dg_sourcepos_option whence X
-	      token_option location X dg_accessibility_option accessibility X
-	      dg_virtuality_option virtuality )
-{
-  dg_class_base ans;
-  ans.base = base;
-  ans.pos = shorten_sourcepos (whence);
-  if (location.present) {
-    shape ptr_sh = f_pointer (f_alignment (ulongsh));
-    ans.location = relative_exp (ptr_sh, location.val);
-  }
-  else
-    ans.location = nilexp;
-  ans.acc = accessibility;
-  ans.virt = virtuality;
-  return ans;
-}
-void init_dg_class_base
-    PROTO_Z ()
-{
-  return;
-}
 dg_classmem f_dummy_dg_classmem;
-dg_classmem f_dg_tag_classmem
+dg_classmem
-    PROTO_N ( (tg, mem) )
-    PROTO_T ( dg_tag tg X dg_classmem mem )
+f_dg_tag_classmem(dg_tag tg, dg_classmem mem)
 {
+	if (tg->key) {
-  if (tg->key) failer ("dg_tag defined twice");
+		failer("dg_tag defined twice");
+	}
-  tg->key = DGK_CLASSMEM;
+	tg->key = DGK_CLASSMEM;
-  mem.tg = tg;
+	mem.tg = tg;
-  return mem;
+	return mem;
 }
-dg_classmem f_dg_field_classmem
+dg_classmem
-    PROTO_N ( (idname, src_pos, offset, field_type, accessibility,
-		discr, deflt) )
-    PROTO_T ( dg_idname idname X dg_sourcepos src_pos X exp offset X
+f_dg_field_classmem(dg_idname idname, dg_sourcepos src_pos, exp offset,
-	      dg_type field_type X dg_accessibility_option accessibility X
+		    dg_type field_type, dg_accessibility_option accessibility,
-	      bool_option discr X dg_default_option deflt )
+		    bool_option discr, dg_default_option deflt)
 {
-  int is_discr = 0;
+	int is_discr = 0;
-  dg_classmem ans;
+	dg_classmem ans;
-  ans.cm_key = DG_CM_FIELD;
+	ans.cm_key = DG_CM_FIELD;
-  ans.d.cm_f.fnam = idname_chars (idname);
+	ans.d.cm_f.fnam = idname_chars(idname);
-  ans.d.cm_f.f_pos = shorten_sourcepos (src_pos);
+	ans.d.cm_f.f_pos = shorten_sourcepos(src_pos);
-  ans.d.cm_f.f_typ = field_type;
+	ans.d.cm_f.f_typ = field_type;
-  ans.d.cm_f.f_offset = diaginfo_exp (offset);
+	ans.d.cm_f.f_offset = diaginfo_exp(offset);
-  ans.d.cm_f.acc = accessibility;
+	ans.d.cm_f.acc = accessibility;
-  if (discr.present)
+	if (discr.present) {
-    is_discr = discr.val;
+		is_discr = discr.val;
+	}
-  ans.d.cm_f.discr = is_discr;
+	ans.d.cm_f.discr = is_discr;
-  ans.d.cm_f.dflt = deflt;
+	ans.d.cm_f.dflt = deflt;
-  ans.tg = (dg_tag)0;
+	ans.tg = (dg_tag)0;
-  return ans;
+	return ans;
 }
-dg_classmem f_dg_function_classmem
+dg_classmem
-    PROTO_N ( (fn, vtable_slot) )
-    PROTO_T ( dg_name fn X exp_option vtable_slot )
+f_dg_function_classmem(dg_name fn, exp_option vtable_slot)
 {
-  dg_classmem ans;
+	dg_classmem ans;
-  ans.cm_key = DG_CM_FN;
+	ans.cm_key = DG_CM_FN;
-  ans.d.cm_fn.fn = fn;
+	ans.d.cm_fn.fn = fn;
-  if (vtable_slot.present)
+	if (vtable_slot.present) {
-    ans.d.cm_fn.slot = diaginfo_exp (vtable_slot.val);
+		ans.d.cm_fn.slot = diaginfo_exp(vtable_slot.val);
-  else
+	} else {
-    ans.d.cm_fn.slot = nilexp;
+		ans.d.cm_fn.slot = nilexp;
+	}
-  ans.tg = (dg_tag)0;
+	ans.tg = (dg_tag)0;
-  return ans;
+	return ans;
 }
-dg_classmem f_dg_indirect_classmem
+dg_classmem
-    PROTO_N ( (idname, src_pos, location, cmem_type) )
-    PROTO_T ( dg_idname idname X dg_sourcepos src_pos X token location X
+f_dg_indirect_classmem(dg_idname idname, dg_sourcepos src_pos, token location,
-	      dg_type cmem_type )
+		       dg_type cmem_type)
 {
-  dg_classmem ans;
+	dg_classmem ans;
-  ans.cm_key = DG_CM_INDIRECT;
+	ans.cm_key = DG_CM_INDIRECT;
-  ans.d.cm_ind.nam = idname_chars (idname);
+	ans.d.cm_ind.nam = idname_chars(idname);
-  ans.d.cm_ind.pos = shorten_sourcepos (src_pos);
+	ans.d.cm_ind.pos = shorten_sourcepos(src_pos);
-  ans.d.cm_ind.typ = cmem_type;
+	ans.d.cm_ind.typ = cmem_type;
-  ans.d.cm_ind.ind_loc = relative_exp (f_pointer (f_alignment (ulongsh)), location);
+	ans.d.cm_ind.ind_loc = relative_exp(f_pointer(f_alignment(ulongsh)),
+					    location);
-  ans.tg = (dg_tag)0;
+	ans.tg = (dg_tag)0;
-  return ans;
+	return ans;
 }
-dg_classmem f_dg_name_classmem
+dg_classmem
-    PROTO_N ( (nam) )
-    PROTO_T ( dg_name nam )
+f_dg_name_classmem(dg_name nam)
 {
-  dg_classmem ans;
+	dg_classmem ans;
-  ans.cm_key = DG_CM_STAT;
+	ans.cm_key = DG_CM_STAT;
-  ans.d.cm_stat = nam;
+	ans.d.cm_stat = nam;
-  ans.tg = (dg_tag)0;
+	ans.tg = (dg_tag)0;
-  return ans;
+	return ans;
 }
+void
-void init_dg_classmem
+init_dg_classmem(void)
-    PROTO_Z ()
+{
-  return;
+	return;
+}
 dg_qualifier f_dummy_dg_qualifier;
 dg_qualifier f_dg_const_qualifier = DG_CONST_T;
 dg_qualifier f_dg_aliased_qualifier = DG_ALIAS_T;
 dg_qualifier f_dg_class_wide_qualifier = DG_CLWID_T;
 dg_qualifier f_dg_limited_qualifier = DG_LIM_T;
-void init_dg_qualifier
-    PROTO_Z ()
-{
-  return;
-}
-dg_bound f_dummy_dg_bound;
-dg_bound f_dg_dynamic_bound
-    PROTO_N ( (bound, sha) )
-    PROTO_T ( dg_tag bound X shape sha )
-{
-  dg_bound ans;
-  ans.is_ref = 1;
-  ans.u.tg = bound;
-  ans.sha = sha;
-  return ans;
-}
+void
-dg_bound f_dg_static_bound
+init_dg_qualifier(void)
-    PROTO_N ( (bound) )
-    PROTO_T ( exp bound )
-{
-  dg_bound ans;
-  if (name(bound) != val_tag)
-    failer ("not a constant");
-  ans.is_ref = 0;
-  ans.u.x = diaginfo_exp (bound);
-  ans.sha = sh(bound);
-  return ans;
-}
-dg_bound f_dg_unknown_bound
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
 {
-  dg_bound ans;
-  ans.is_ref = 1;
-  ans.u.tg = (dg_tag)0;
-  ans.sha = sha;
-  return ans;
+	return;
+}
-void init_dg_bound
-    PROTO_Z ()
-{
-  return;
-}
-dg_dim f_dummy_dg_dim;
-dg_dim f_dg_dim_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,  DG_DIM_SORT, (tokval*)0);
-   return v.tk_dg_dim;
-}
-dg_dim f_dg_tag_dim
-    PROTO_N ( (tg, d) )
-    PROTO_T ( dg_tag tg X dg_dim d )
-{
-  if (tg->key) failer ("dg_tag defined twice");
-  tg->key = DGK_DIM;
-  d.tg = tg;
-  return d;
-}
-dg_dim f_dg_bounds_dim
-    PROTO_N ( (low, high, index_type) )
-    PROTO_T ( dg_bound low X dg_bound high X dg_type index_type )
-{
-  dg_dim ans;
-  ans.d_key = DG_DIM_BOUNDS;
-  ans.low_ref = low.is_ref;
-  ans.hi_ref = high.is_ref;
-  ans.hi_cnt = 0;
-  ans.d_typ = index_type;
-  ans.sha = low.sha;
-  ans.lower = low.u;
-  ans.upper = high.u;
-  if (low.is_ref || high.is_ref)
-    ans.count = -1;
-  else
-    ans.count = (long)(no(son(high.u.x)) - no(son(low.u.x)) + 1);
-  ans.tg = (dg_tag)0;
-  return ans;
-}
-dg_dim f_dg_count_dim
-    PROTO_N ( (low, count, index_type) )
-    PROTO_T ( dg_bound low X dg_bound count X dg_type index_type )
-{
-  dg_dim ans;
-  ans.d_key = DG_DIM_BOUNDS;
-  ans.low_ref = low.is_ref;
-  ans.hi_ref = count.is_ref;
-  ans.hi_cnt = 1;
-  ans.d_typ = index_type;
-  ans.sha = low.sha;
-  ans.lower = low.u;
-  ans.upper = count.u;
-  if (count.is_ref)
-    ans.count = -1;
-  else
-    ans.count = (long)(no(son(count.u.x)));
-  ans.tg = (dg_tag)0;
-  return ans;
-}
-dg_dim f_dg_type_dim
-    PROTO_N ( (type, n) )
-    PROTO_T ( dg_type type X nat_option n )
-{
-  dg_dim ans;
-  ans.d_key = DG_DIM_TYPE;
-  ans.d_typ = type;
-  if (n.present)
-    ans.count = (long)n.val.nat_val.small_nat;
-  else
-    ans.count = -1;
-  ans.tg = (dg_tag)0;
-  return ans;
-}
-dg_dim f_dg_unspecified_dim;
-void init_dg_dim
-    PROTO_Z ()
-{
-  f_dg_unspecified_dim.d_key = DG_DIM_NONE;
-  f_dg_unspecified_dim.low_ref = f_dg_unspecified_dim.hi_ref = 1;
-  f_dg_unspecified_dim.hi_cnt = 0;
-  f_dg_unspecified_dim.count = -1;
-  f_dg_unspecified_dim.d_typ = (dg_type)0;
-  f_dg_unspecified_dim.sha = f_top;
-  f_dg_unspecified_dim.lower.tg = f_dg_unspecified_dim.upper.tg = (dg_tag)0;
-  f_dg_unspecified_dim.tg = (dg_tag)0;
-  return;
-}
-dg_enum f_dummy_dg_enum;
-dg_enum f_make_dg_enum
-    PROTO_N ( (value, idname, src_pos) )
-    PROTO_T ( exp value X dg_idname idname X dg_sourcepos src_pos )
-{
-  dg_enum ans;
-  if (!value || name(value) != val_tag)
-    failer ("enum value not const");
-  ans.enam = idname_chars (idname);
-  ans.pos = shorten_sourcepos (src_pos);
-  ans.value = diaginfo_exp (value);
-  ans.is_chn = 0;
-  ans.tg = (dg_tag)0;
-  return ans;
-}
-dg_enum f_dg_char_enum
-    PROTO_N ( (value, idchar, src_pos) )
-    PROTO_T ( exp value X nat idchar X dg_sourcepos src_pos )
-{
-  dg_enum ans;
-  if (!value || name(value) != val_tag)
-    failer ("enum value not const");
-  ans.chn = idchar.nat_val.small_nat;
-  ans.pos = shorten_sourcepos (src_pos);
-  ans.value = diaginfo_exp (value);
-  ans.is_chn = 1;
-  ans.tg = (dg_tag)0;
-  return ans;
-}
-dg_enum f_dg_tag_enum
+dg_bound f_dummy_dg_bound;
-    PROTO_N ( (tg, e) )
+dg_bound
-    PROTO_T ( dg_tag tg X dg_enum e )
+f_dg_dynamic_bound(dg_tag bound, shape sha)
+{
+	dg_bound ans;
+	ans.is_ref = 1;
+	ans.u.tg = bound;
+	ans.sha = sha;
+	return ans;
+}
+dg_bound
+f_dg_static_bound(exp bound)
+{
+	dg_bound ans;
+	if (name(bound) != val_tag) {
+		failer("not a constant");
+	}
+	ans.is_ref = 0;
+	ans.u.x = diaginfo_exp(bound);
+	ans.sha = sh(bound);
+	return ans;
+}
+dg_bound
+f_dg_unknown_bound(shape sha)
+{
+	dg_bound ans;
+	ans.is_ref = 1;
+	ans.u.tg = (dg_tag)0;
+	ans.sha = sha;
+	return ans;
+}
+void
+init_dg_bound(void)
+{
+	return;
+}
+dg_dim f_dummy_dg_dim;
+dg_dim
+f_dg_dim_apply_token(token token_value, bitstream token_args)
+{
+	tokval v;
+	v = apply_tok(token_value, token_args, DG_DIM_SORT, (tokval *)0);
+	return v.tk_dg_dim;
+}
+dg_dim
+f_dg_tag_dim(dg_tag tg, dg_dim d)
+{
+	if (tg->key) {
-  if (tg->key) failer ("dg_tag defined twice");
+		failer("dg_tag defined twice");
+	}
+	tg->key = DGK_DIM;
+	d.tg = tg;
+	return d;
+}
+dg_dim
+f_dg_bounds_dim(dg_bound low, dg_bound high, dg_type index_type)
+{
+	dg_dim ans;
+	ans.d_key = DG_DIM_BOUNDS;
+	ans.low_ref = low.is_ref;
+	ans.hi_ref = high.is_ref;
+	ans.hi_cnt = 0;
+	ans.d_typ = index_type;
+	ans.sha = low.sha;
+	ans.lower = low.u;
+	ans.upper = high.u;
+	if (low.is_ref || high.is_ref) {
+		ans.count = -1;
+	} else {
+		ans.count = (long)(no(son(high.u.x)) - no(son(low.u.x)) + 1);
+	}
+	ans.tg = (dg_tag)0;
+	return ans;
+}
+dg_dim
+f_dg_count_dim(dg_bound low, dg_bound count, dg_type index_type)
+{
+	dg_dim ans;
+	ans.d_key = DG_DIM_BOUNDS;
+	ans.low_ref = low.is_ref;
+	ans.hi_ref = count.is_ref;
+	ans.hi_cnt = 1;
+	ans.d_typ = index_type;
+	ans.sha = low.sha;
+	ans.lower = low.u;
+	ans.upper = count.u;
+	if (count.is_ref) {
+		ans.count = -1;
+	} else {
+		ans.count = (long)(no(son(count.u.x)));
+	}
+	ans.tg = (dg_tag)0;
+	return ans;
+}
+dg_dim
+f_dg_type_dim(dg_type type, nat_option n)
+{
+	dg_dim ans;
+	ans.d_key = DG_DIM_TYPE;
+	ans.d_typ = type;
+	if (n.present) {
+		ans.count = (long)n.val.nat_val.small_nat;
+	} else {
+		ans.count = -1;
+	}
+	ans.tg = (dg_tag)0;
+	return ans;
+}
+dg_dim f_dg_unspecified_dim;
+void
+init_dg_dim(void)
+{
+	f_dg_unspecified_dim.d_key = DG_DIM_NONE;
+	f_dg_unspecified_dim.low_ref = f_dg_unspecified_dim.hi_ref = 1;
+	f_dg_unspecified_dim.hi_cnt = 0;
+	f_dg_unspecified_dim.count = -1;
+	f_dg_unspecified_dim.d_typ = (dg_type)0;
+	f_dg_unspecified_dim.sha = f_top;
+	f_dg_unspecified_dim.lower.tg = f_dg_unspecified_dim.upper.tg =
+	    (dg_tag)0;
+	f_dg_unspecified_dim.tg = (dg_tag)0;
+	return;
+}
+dg_enum f_dummy_dg_enum;
+dg_enum
+f_make_dg_enum(exp value, dg_idname idname, dg_sourcepos src_pos)
+{
+	dg_enum ans;
+	if (!value || name(value) != val_tag) {
+		failer("enum value not const");
+	}
+	ans.enam = idname_chars(idname);
+	ans.pos = shorten_sourcepos(src_pos);
+	ans.value = diaginfo_exp(value);
+	ans.is_chn = 0;
+	ans.tg = (dg_tag)0;
+	return ans;
+}
+dg_enum
+f_dg_char_enum(exp value, nat idchar, dg_sourcepos src_pos)
+{
+	dg_enum ans;
+	if (!value || name(value) != val_tag) {
+		failer("enum value not const");
+	}
+	ans.chn = idchar.nat_val.small_nat;
+	ans.pos = shorten_sourcepos(src_pos);
+	ans.value = diaginfo_exp(value);
+	ans.is_chn = 1;
+	ans.tg = (dg_tag)0;
+	return ans;
+}
+dg_enum
+f_dg_tag_enum(dg_tag tg, dg_enum e)
+{
+	if (tg->key) {
+		failer("dg_tag defined twice");
+	}
-  tg->key = DGK_ENUM;
+	tg->key = DGK_ENUM;
-  e.tg = tg;
+	e.tg = tg;
-  return e;
+	return e;
+}
-void init_dg_enum
-    PROTO_Z ()
-{
-  return;
-}
-dg_param f_dummy_dg_param;
-dg_param f_dg_object_param
+void
-    PROTO_N ( (idname, src_pos, mode, param_type, deflt) )
-    PROTO_T ( dg_idname_option idname X dg_sourcepos_option src_pos X
-	      dg_param_mode_option mode X dg_type param_type X
-	      dg_default_option deflt )
+init_dg_enum(void)
+{
-  dg_param ans;
-  ans.pnam = idname_chars (idname);
-  ans.ppos = shorten_sourcepos (src_pos);
-  ans.pmode = mode;
-  ans.p_typ = param_type;
-  ans.p_dflt = deflt;
-  return ans;
+	return;
+}
-dg_param f_dg_type_param
+dg_param f_dummy_dg_param;
+dg_param
+f_dg_object_param(dg_idname_option idname, dg_sourcepos_option src_pos,
+		  dg_param_mode_option mode, dg_type param_type,
+		  dg_default_option deflt)
+{
+	dg_param ans;
-    PROTO_N ( (idname, src_pos, fparams) )
+	ans.pnam = idname_chars(idname);
+	ans.ppos = shorten_sourcepos(src_pos);
+	ans.pmode = mode;
+	ans.p_typ = param_type;
+	ans.p_dflt = deflt;
+	return ans;
+}
+dg_param
-    PROTO_T ( dg_idname_option idname X dg_sourcepos_option src_pos X dg_param_list fparams )
+f_dg_type_param(dg_idname_option idname, dg_sourcepos_option src_pos,
+		dg_param_list fparams)
 {
-  failer ("dg_type_param not yet supported");
+	failer("dg_type_param not yet supported");
-  UNUSED (idname);
+	UNUSED(idname);
-  UNUSED (src_pos);
+	UNUSED(src_pos);
-  UNUSED (fparams);
+	UNUSED(fparams);
-  return f_dummy_dg_param;
+	return f_dummy_dg_param;
 }
-void init_dg_param
+void
-    PROTO_Z ()
+init_dg_param(void)
+{
-  return;
+	return;
+}
 dg_param_mode f_dummy_dg_param_mode;
 dg_param_mode f_dg_in_mode = DG_IN_MODE;
 dg_param_mode f_dg_out_mode = DG_OUT_MODE;
 dg_param_mode f_dg_inout_mode = DG_INOUT_MODE;
+void
-void init_dg_param_mode
+init_dg_param_mode(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
 dg_accessibility f_dummy_dg_accessibility;
 dg_accessibility f_dg_public_accessibility = DG_ACC_PUB;
 dg_accessibility f_dg_private_accessibility = DG_ACC_PRIV;
 dg_accessibility f_dg_protected_accessibility = DG_ACC_PROT;
 dg_accessibility f_dg_local_accessibility = DG_ACC_LOC;
+void
-void init_dg_accessibility
+init_dg_accessibility(void)
-    PROTO_Z ()
+{
-  return;
+	return;
+}
 dg_virtuality f_dummy_dg_virtuality;
 dg_virtuality f_dg_virtual_virtuality = DG_VIRT_VIRT;
 dg_virtuality f_dg_abstract_virtuality = DG_VIRT_PURE;
+void
-void init_dg_virtuality
+init_dg_virtuality(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
 dg_filename f_dummy_dg_filename;
-dg_filename f_dg_filename_apply_token
+dg_filename
-    PROTO_N ( (token_value, token_args) )
-    PROTO_T ( token token_value X bitstream token_args )
+f_dg_filename_apply_token(token token_value, bitstream token_args)
 {
-   tokval v;
+	tokval v;
-   v = apply_tok(token_value, token_args,  DG_FILENAME_SORT, (tokval*)0);
+	v = apply_tok(token_value, token_args, DG_FILENAME_SORT, (tokval *)0);
-   return v.tk_dg_filename;
+	return v.tk_dg_filename;
 }
-dg_filename f_make_dg_filename
+dg_filename
-    PROTO_N ( (date, machine, path, file) )
-    PROTO_T ( nat date X string machine X string path X string file )
+f_make_dg_filename(nat date, string machine, string path, string file)
 {
-  return get_filename ((long)(date.nat_val.small_nat), machine.ints.chars,
+	return get_filename((long)(date.nat_val.small_nat), machine.ints.chars,
-	path.ints.chars, file.ints.chars);
+			    path.ints.chars, file.ints.chars);
 }
+void
-void init_dg_filename
+init_dg_filename(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
 dg_sourcepos f_dummy_dg_sourcepos;
-dg_sourcepos f_dg_span_sourcepos
+dg_sourcepos f_dg_span_sourcepos(dg_filename file, nat from_line,
-    PROTO_N ( (file, from_line, from_column, to_file, to_line, to_column) )
+				 nat from_column, dg_filename_option to_file,
+				 nat to_line, nat to_column)
+{
+	dg_sourcepos ans;
+	ans.sp_key = SP_SPAN;
+	ans.file = file;
+	if (!(ans.to_file = to_file)) {
+		ans.to_file = file;
+	}
+	ans.from_line = from_line.nat_val.small_nat;
+	ans.from_column = (short)from_column.nat_val.small_nat;
+	ans.to_line = to_line.nat_val.small_nat;
+	ans.to_column = (short)to_column.nat_val.small_nat;
+	return ans;
+}
+dg_sourcepos
-    PROTO_T ( dg_filename file X nat from_line X nat from_column X
+f_dg_mark_sourcepos(dg_filename file, nat line, nat column)
+{
+	dg_sourcepos ans;
+	ans.sp_key = SP_SHORT;
+	ans.file = file;
+	ans.from_line = line.nat_val.small_nat;
+	ans.from_column = (short)column.nat_val.small_nat;
+	return ans;
+}
+dg_sourcepos
-	      dg_filename_option to_file X nat to_line X nat to_column )
+f_dg_file_sourcepos(dg_filename file)
+{
-  dg_sourcepos ans;
+	dg_sourcepos ans;
-  ans.sp_key = SP_SPAN;
+	ans.sp_key = SP_FILE;
-  ans.file = file;
+	ans.file = file;
-  if (!(ans.to_file = to_file))
-    ans.to_file = file;
-  ans.from_line = from_line.nat_val.small_nat;
-  ans.from_column = (short)from_column.nat_val.small_nat;
-  ans.to_line = to_line.nat_val.small_nat;
-  ans.to_column = (short)to_column.nat_val.small_nat;
-  return ans;
+	return ans;
+}
-dg_sourcepos f_dg_mark_sourcepos
-    PROTO_N ( (file, line, column) )
-    PROTO_T ( dg_filename file X nat line X nat column )
-{
-  dg_sourcepos ans;
-  ans.sp_key = SP_SHORT;
-  ans.file = file;
-  ans.from_line = line.nat_val.small_nat;
-  ans.from_column = (short)column.nat_val.small_nat;
-  return ans;
-}
-dg_sourcepos f_dg_file_sourcepos
-    PROTO_N ( (file) )
-    PROTO_T ( dg_filename file )
-{
-  dg_sourcepos ans;
-  ans.sp_key = SP_FILE;
-  ans.file = file;
-  return ans;
-}
 dg_sourcepos f_dg_global_sourcepos;
 dg_sourcepos f_dg_null_sourcepos;
-dg_type_list add_dg_type_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( dg_type_list list X dg_type elem X int index )
-{
-  list.array[index] = elem;
-  return list;
-}
-dg_param_list new_dg_param_list
+dg_constraint
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+f_dg_value_constraint(dg_tag_option ref_member, exp value)
+{
+	dg_constraint ans = (dg_constraint)xcalloc(1, sizeof(struct dg_con));
+	ans->refmem = ref_member;
-  dg_param_list ans;
+	ans->is_val = 1;
-  ans.len = n;
+	ans->u.val = value;
-  ans.array = (dg_param *) xcalloc (n, sizeof (dg_param));
+	ans->next = (dg_constraint)0;
-  return ans;
+	return ans;
+}
-dg_param_list add_dg_param_list
+void
-    PROTO_N ( (list, elem, index) )
+init_dg_constraint(void)
-    PROTO_T ( dg_param_list list X dg_param elem X int index )
+{
+	return;
+}
+dg_default f_dummy_dg_default;
+dg_default
+f_make_dg_default(exp_option value, dg_sourcepos_option src_span)
+{
+	dg_default ans;
+	if (value.present) {
+		ans.val = diaginfo_exp(value.val);
+	} else {
-  list.array[index] = elem;
+		ans.val = nilexp;
+	}
+	ans.span = src_span;
+	ans.lab = (long)0;
+	return ans;
+}
+void
+init_dg_default(void)
+{
+	return;
+}
+dg_idname f_dummy_dg_idname;
+dg_idname
+f_dg_idname_apply_token(token token_value, bitstream token_args)
+{
+	tokval v;
+	v = apply_tok(token_value, token_args, DG_IDNAME_SORT, (tokval *)0);
+	return v.tk_dg_idname;
+}
+dg_idname
+f_dg_sourcestring_idname(string src_name)
+{
+	dg_idname ans;
+	ans.id_key = DG_ID_SRC;
+	ans.idd.nam = src_name.ints.chars;
+	return ans;
+}
+dg_idname
+f_dg_anonymous_idname(string_option descr)
+{
+	dg_idname ans;
+	ans.id_key = DG_ID_ANON;
+	UNUSED(descr);
+	ans.idd.nam = "";
-  return list;
+	return ans;
+}
+dg_idname
+f_dg_artificial_idname(string_option aname)
+{
+	dg_idname ans;
-dg_dim_list new_dg_dim_list
+	ans.id_key = DG_ID_ARTFL;
-    PROTO_N ( (n) )
+	if (aname.present) {
+		ans.idd.nam = aname.val.ints.chars;
+	} else {
-    PROTO_T ( int n )
+		ans.idd.nam = "";
+	}
+	return ans;
+}
+dg_idname
+f_dg_instance_idname(dg_idname_option idname, dg_idname spec,
+		     dg_sourcepos whence, dg_name_list aparams)
+{
+	dg_idname ans;
+	ans.id_key = DG_ID_INST;
+	ans.idd.instance = (dg_instantn *)xcalloc(1, sizeof(dg_instantn));
+	ans.idd.instance->nam = idname;
+	ans.idd.instance->spec = spec;
+	ans.idd.instance->whence = shorten_sourcepos(whence);
+	ans.idd.instance->params = aparams;
+	if (ans.idd.instance->nam.id_key == DG_ID_INST ||
+	    ans.idd.instance->spec.id_key == DG_ID_INST) {
+		failer("multiple instantiation");
+	}
+	return ans;
+}
+dg_idname
+f_dg_external_idname(string src_name)
+{
 dg_append f_dummy_dg_append;
-dg_append f_dg_name_append
+dg_append
-    PROTO_N ( (tg, nam) )
-    PROTO_T ( dg_tag tg X dg_name nam )
+f_dg_name_append(dg_tag tg, dg_name nam)
+{
-  if (tg->key != DGK_NAMELIST) failer("wrong dg_tag");
+	if (tg->key != DGK_NAMELIST) {
+		failer("wrong dg_tag");
+	}
-  *(tg->p.nl) = add_dg_name_list (*(tg->p.nl), nam, 0);
+	*(tg->p.nl) = add_dg_name_list(*(tg->p.nl), nam, 0);
-  return f_dummy_dg_append;
+	return f_dummy_dg_append;
+}
+void
+init_dg_append(void)
+{
+	return;
+}
+dg_append_list
+new_dg_append_list(int n)
+{
+	return(dg_append_list)0;
+}
+dg_append_list
+add_dg_append_list(dg_append_list list, dg_append elem, int index)
+{
+	return list;
+}
+dg_macro_list
+new_dg_macro_list(int n)
+{
+	dg_macro_list ans;
+	ans.len = n;
+	ans.array = (dg_macro *)xcalloc(n, sizeof(dg_macro));
+	return ans;
+}
+dg_macro_list
+add_dg_macro_list(dg_macro_list list, dg_macro elem, int index)
+{
+	list.array[index] = elem;
+	return list;
+}
+dg_idname_list
+new_dg_idname_list(int n)
+{
+	return new_string_list(n);
+}
-void init_dg_append
-    PROTO_Z ()
-{
-  return;
-}
-dg_append_list new_dg_append_list
+dg_idname_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+add_dg_idname_list(dg_idname_list list, dg_idname elem, int index)
+{
-  return (dg_append_list)0;
-}
-dg_append_list add_dg_append_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( dg_append_list list X dg_append elem X int index )
-{
-  return list;
-}
-dg_macro_list new_dg_macro_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  dg_macro_list ans;
-  ans.len = n;
-  ans.array = (dg_macro *)xcalloc(n, sizeof(dg_macro));
-  return ans;
-}
-dg_macro_list add_dg_macro_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( dg_macro_list list X dg_macro elem X int index )
-{
-  list.array[index] = elem;
-  return list;
-}
-dg_idname_list new_dg_idname_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
-{
-  return new_string_list (n);
-}
-dg_idname_list add_dg_idname_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( dg_idname_list list X dg_idname elem X int index )
-{
-  list.array[index] = idname_chars (elem);
+	list.array[index] = idname_chars(elem);
-  return list;
+	return list;
+}
 dg_idname_option no_dg_idname_option;
-dg_idname_option yes_dg_idname_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_idname elem )
-{
-  return elem;
-}
-void init_dg_idname_option
+dg_idname_option
-    PROTO_Z ()
-{
-  no_dg_idname_option.id_key = DG_ID_NONE;
-  no_dg_idname_option.idd.nam = "";
+yes_dg_idname_option(dg_idname elem)
-  return;
-}
-dg_name_option no_dg_name_option = (dg_name)0;
-dg_name_option yes_dg_name_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_name elem )
+{
-  return elem;
+	return elem;
-}
-void init_dg_name_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_accessibility_option no_dg_accessibility_option = DG_ACC_NONE;
-dg_accessibility_option yes_dg_accessibility_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_accessibility elem )
-{
-  return elem;
-}
-void init_dg_accessibility_option
-    PROTO_Z ()
-{
-  return;
+}
-dg_tag_option no_dg_tag_option = (dg_tag)0;
-dg_tag_option yes_dg_tag_option
+void
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_tag elem )
+init_dg_idname_option(void)
+{
+	no_dg_idname_option.id_key = DG_ID_NONE;
+	no_dg_idname_option.idd.nam = "";
-  return elem;
+	return;
+}
-void init_dg_tag_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_virtuality_option no_dg_virtuality_option = DG_VIRT_NONE;
-dg_virtuality_option yes_dg_virtuality_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_virtuality elem )
-{
-  return elem;
-}
-void init_dg_virtuality_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_sourcepos_option no_dg_sourcepos_option;
-dg_sourcepos_option yes_dg_sourcepos_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_sourcepos elem )
-{
-  return elem;
-}
-void init_dg_sourcepos_option
-    PROTO_Z ()
-{
-  no_dg_sourcepos_option.sp_key = SP_NULL;
-  no_short_sourcepos = shorten_sourcepos (no_dg_sourcepos_option);
-  return;
-}
-dg_type_option no_dg_type_option = (dg_type)0;
-dg_type_option yes_dg_type_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_type elem )
-{
-  return elem;
-}
+dg_name_option no_dg_name_option = (dg_name)0;
+dg_name_option
+yes_dg_name_option(dg_name elem)
+{
+	return elem;
+}
+void
-void init_dg_type_option
+init_dg_name_option(void)
+{
+	return;
+}
+dg_accessibility_option no_dg_accessibility_option = DG_ACC_NONE;
+dg_accessibility_option
+yes_dg_accessibility_option(dg_accessibility elem)
+{
+	return elem;
+}
+void
+init_dg_accessibility_option(void)
+{
+	return;
+}
+dg_tag_option no_dg_tag_option = (dg_tag)0;
+dg_tag_option
+yes_dg_tag_option(dg_tag elem)
+{
+	return elem;
+}
+void
+init_dg_tag_option(void)
+{
+	return;
+}
+dg_virtuality_option no_dg_virtuality_option = DG_VIRT_NONE;
+dg_virtuality_option
+yes_dg_virtuality_option(dg_virtuality elem)
+{
+	return elem;
+}
+void
+init_dg_virtuality_option(void)
+{
+	return;
+}
+dg_sourcepos_option no_dg_sourcepos_option;
+dg_sourcepos_option
+yes_dg_sourcepos_option(dg_sourcepos elem)
+{
-    PROTO_Z ()
+	return elem;
+}
+void
+init_dg_sourcepos_option(void)
+{
+	no_dg_sourcepos_option.sp_key = SP_NULL;
+	no_short_sourcepos = shorten_sourcepos(no_dg_sourcepos_option);
-  return;
+	return;
 }
-dg_type_list_option no_dg_type_list_option;
-dg_type_list_option yes_dg_type_list_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_type_list elem )
-{
-  return elem;
-}
-void init_dg_type_list_option
-    PROTO_Z ()
-{
-  no_dg_type_list_option.len = -1;
-  no_dg_type_list_option.array = (dg_type *)0;
-  return;
-}
-dg_constraint_list_option no_dg_constraint_list_option = (dg_constraint)0;
-dg_constraint_list_option yes_dg_constraint_list_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_constraint_list elem )
-{
-  return elem;
-}
-void init_dg_constraint_list_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_varpart_option no_dg_varpart_option = (dg_varpart_option)0;
-dg_varpart_option yes_dg_varpart_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_varpart elem )
-{
-  dg_varpart_option ans = (dg_varpart_option)xcalloc(1, sizeof(dg_varpart));
-  *ans = elem;
-  return ans;
-}
-void init_dg_varpart_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_param_mode_option no_dg_param_mode_option = DG_NO_MODE;
-dg_param_mode_option yes_dg_param_mode_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_param_mode elem )
-{
-  return elem;
-}
-void init_dg_param_mode_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_dim_option no_dg_dim_option;
-dg_dim_option yes_dg_dim_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_dim elem )
-{
-  failer ("dg_dim_option not done yet");
-  return no_dg_dim_option;
-}
-void init_dg_dim_option
-    PROTO_Z ()
-{
-  return;
-}
-dg_filename_option no_dg_filename_option = (dg_filename)0;
-dg_filename_option yes_dg_filename_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_filename elem )
-{
-  return elem;
-}
-void init_dg_filename_option
-    PROTO_Z ()
-{
-  return;
-}
+dg_type_option no_dg_type_option = (dg_type)0;
-dg_default_option no_dg_default_option = (dg_default *)0;
-dg_default_option yes_dg_default_option
+dg_type_option
-    PROTO_N ( (elem) )
-    PROTO_T ( dg_default elem )
+yes_dg_type_option(dg_type elem)
+{
+	return elem;
+}
+void
+init_dg_type_option(void)
+{
+	return;
+}
+dg_type_list_option no_dg_type_list_option;
+dg_type_list_option
+yes_dg_type_list_option(dg_type_list elem)
+{
+	return elem;
+}
+void
+init_dg_type_list_option(void)
+{
+	no_dg_type_list_option.len = -1;
+	no_dg_type_list_option.array = (dg_type *)0;
+	return;
+}
+dg_constraint_list_option no_dg_constraint_list_option = (dg_constraint)0;
+dg_constraint_list_option
+yes_dg_constraint_list_option(dg_constraint_list elem)
+{
+	return elem;
+}
+void
+init_dg_constraint_list_option(void)
+{
+	return;
+}
+dg_varpart_option no_dg_varpart_option = (dg_varpart_option)0;
+dg_varpart_option
+yes_dg_varpart_option(dg_varpart elem)
+{
+	dg_varpart_option ans =
-  dg_default_option ans = (dg_default_option)xcalloc(1, sizeof(dg_default));
+	    (dg_varpart_option)xcalloc(1, sizeof(dg_varpart));
-  *ans = elem;
+	*ans = elem;
-  return ans;
+	return ans;
+}
+void
+init_dg_varpart_option(void)
+{
+	return;
+}
+dg_param_mode_option no_dg_param_mode_option = DG_NO_MODE;
+dg_param_mode_option
+yes_dg_param_mode_option(dg_param_mode elem)
+{
+	return elem;
+}
+void
+init_dg_param_mode_option(void)
+{
+	return;
 }
+dg_dim_option no_dg_dim_option;
+dg_dim_option
+yes_dg_dim_option(dg_dim elem)
+{
+	failer("dg_dim_option not done yet");
-void init_dg_default_option
+	return no_dg_dim_option;
+}
+void
+init_dg_dim_option(void)
+{
+	return;
+}
+dg_filename_option no_dg_filename_option = (dg_filename)0;
+dg_filename_option
+yes_dg_filename_option(dg_filename elem)
+{
-    PROTO_Z ()
+	return elem;
+}
+void
+init_dg_filename_option(void)
 {
-  return;
+	return;
+}
+dg_default_option no_dg_default_option = (dg_default *)0;
-void init_capsule_dgtags
+dg_default_option
+yes_dg_default_option(dg_default elem)
+{
+	dg_default_option ans =
+	    (dg_default_option)xcalloc(1, sizeof(dg_default));
-    PROTO_Z ()
+	*ans = elem;
+	return ans;
+}
+void
+init_dg_default_option(void)
+{
+	return;
+}
+void
+init_capsule_dgtags(void)
 {
-  /* the space has been calloced in read_fns */
+	/* the space has been calloced in read_fns */
-  int i;
+	int i;
-  for (i = 0; i < capsule_no_of_dgtags; ++i)
+	for (i = 0; i < capsule_no_of_dgtags; ++i) {
-  {
-    init_dgtag (&capsule_dgtab[i]);
+		init_dgtag(&capsule_dgtab[i]);
-  }
+	}
-  return;
+	return;
 }
+void
-void init_unit_dgtags
+init_unit_dgtags(int n)
+{
+	int i;
+	unit_dgtagtab = (dgtag_struct *)xcalloc(unit_no_of_dgtags - n,
-    PROTO_N ( (n) )
+						sizeof(dgtag_struct));
+	for (i = 0; i < unit_no_of_dgtags - n; ++i) {
-    PROTO_T ( int n )
+		init_dgtag(&unit_dgtagtab[i]);
+	}
+	return;
-{
+}
+void
+start_make_dg_comp_unit(int toks, int tags, int als, int dgnames)
+{
-  int i;
+	int i;
+	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_dgtags = dgnames;
-  unit_dgtagtab = (dgtag_struct *) xcalloc(unit_no_of_dgtags - n,
+	unit_ind_dgtags = (dgtag_struct **)xcalloc(unit_no_of_dgtags,
-					sizeof(dgtag_struct));
+						   sizeof(dgtag_struct *));
+	for (i = 0; i < unit_no_of_dgtags; ++i) {
+		unit_ind_dgtags[i] = (dgtag_struct *)0;
+	}
+	return;
+}
+void
+f_make_dg_comp_unit(void)
+{
+	int i;
+	int j = 0;
+	int no_of_labels;
+#ifdef NEWDIAGS
+	int was_within_diags;
+#endif
+	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_dgtags - n; ++i)
+	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_dgtags; ++i) {
+		if (unit_ind_dgtags[i] == (dgtag_struct *)0) {
-    init_dgtag (&unit_dgtagtab[i]);
+			unit_ind_dgtags[i] = &unit_dgtagtab[j++];
+		}
+	}
+#ifdef NEWDIAGS
+	was_within_diags = within_diags;
+	within_diags = 1;
+#endif
+	{
+		dg_compilation *comp_unit_ptr = &all_comp_units;
+		while (*comp_unit_ptr) {
+			comp_unit_ptr = &(*comp_unit_ptr)->another;
-  }
+		}
+		start_bytestream();
+		no_of_labels = small_dtdfint();
+		unit_no_of_labels = no_of_labels;
+		unit_labtab = (exp *)xcalloc(unit_no_of_labels, sizeof(exp));
+		(*comp_unit_ptr) = d_dg_compilation();
+		IGNORE d_dg_append_list();
+		end_bytestream();
+	}
+#ifdef NEWDIAGS
+	within_diags = was_within_diags;
+#endif
+	return;
+}
+void
+f_make_dglink(tdfint i, tdfint ext)
+{
+	unit_ind_dgtags[natint(i)] = &capsule_dgtab[natint(ext)];
-  return;
+	return;
+}
-void start_make_dg_comp_unit
+linkextern
-    PROTO_N ( (toks, tags, als, dgnames) )
-    PROTO_T ( int toks X int tags X int als X int dgnames )
+f_make_dgtagextern(tdfint internal, external ext)
+{
+	dg_tag tg = &capsule_dgtab[natint(internal)];
+	tg->outref.k = LAB_STR;
+	tg->outref.u.s = external_to_string(ext);
-  int i;
+	return 0;
+}
-  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_dgtags = dgnames;
-  unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,
-                    sizeof(dgtag_struct *));
-  for (i = 0; i < unit_no_of_dgtags; ++i)
-    unit_ind_dgtags[i] = (dgtag_struct *)0;
-  return;
-}
+exp
-void f_make_dg_comp_unit
+f_dg_exp(exp body, dg diagnostic)
-    PROTO_Z ()
+{
-  int i;
-  int j = 0;
-  int no_of_labels;
 #ifdef NEWDIAGS
+	dgf(body) = add_dg_list(add_dg_list(new_dg_list(2), diagnostic, 0),
-  int was_within_diags;
+				dgf(body), 1);
 #endif
-  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;
+	return body;
-  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_dgtags; ++i)
-  {
-    if (unit_ind_dgtags[i] == (dgtag_struct *)0)
-      unit_ind_dgtags[i] = &unit_dgtagtab[j++];
-  };
-#ifdef NEWDIAGS
-  was_within_diags = within_diags;
-  within_diags = 1;
-#endif
-  {
+exp
-    dg_compilation * comp_unit_ptr = &all_comp_units;
-    while (* comp_unit_ptr)
-      comp_unit_ptr = &(* comp_unit_ptr)->another;
-    start_bytestream();
-    no_of_labels = small_dtdfint();
-    unit_no_of_labels = no_of_labels;
-    unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));
-    (* comp_unit_ptr) = d_dg_compilation();
-    IGNORE d_dg_append_list();
-    end_bytestream();
-  }
-#ifdef NEWDIAGS
-  within_diags = was_within_diags;
-#endif
-  return;
-}
-void f_make_dglink
-    PROTO_N ( (i, ext) )
-    PROTO_T ( tdfint i X tdfint ext )
-{
-  unit_ind_dgtags[natint(i)] =
-      &capsule_dgtab[natint(ext)];
-  return;
-}
-linkextern f_make_dgtagextern
-    PROTO_N ( (internal, ext) )
-    PROTO_T ( tdfint internal X external ext )
-{
-  dg_tag tg = &capsule_dgtab[natint(internal)];
-  tg->outref.k = LAB_STR;
-  tg->outref.u.s = external_to_string(ext);
-  return 0;
-}
-exp f_dg_exp
-    PROTO_N ( (body, diagnostic) )
-    PROTO_T ( exp body X dg diagnostic )
-{
-#ifdef NEWDIAGS
-  dgf(body) = add_dg_list (add_dg_list (new_dg_list (2), diagnostic, 0), dgf(body), 1);
-#endif
-  return body;
-}
-exp read_dg_exp
-    PROTO_N ( (body) )
-    PROTO_T ( exp body )
+read_dg_exp(exp body)
+{
-  dg diag;
+	dg diag;
 #ifdef NEWDIAGS
-  int was_within_diags = within_diags;
+	int was_within_diags = within_diags;
-  within_diags = 1;
+	within_diags = 1;
-  diag = d_dg();
+	diag = d_dg();
-  within_diags = was_within_diags;
+	within_diags = was_within_diags;
 #endif
-  return f_dg_exp (body, diag);
+	return f_dg_exp(body, diag);
+}

Subversion Repositories tendra.SVN

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