コード例 #1
0
ファイル: dump-parse-tree.c プロジェクト: ChaosJohn/gcc
static void
show_components (gfc_symbol *sym)
{
  gfc_component *c;

  for (c = sym->components; c; c = c->next)
    {
      fprintf (dumpfile, "(%s ", c->name);
      show_typespec (&c->ts);
      if (c->attr.allocatable)
	fputs (" ALLOCATABLE", dumpfile);
      if (c->attr.pointer)
	fputs (" POINTER", dumpfile);
      if (c->attr.proc_pointer)
	fputs (" PPC", dumpfile);
      if (c->attr.dimension)
	fputs (" DIMENSION", dumpfile);
      fputc (' ', dumpfile);
      show_array_spec (c->as);
      if (c->attr.access)
	fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
      fputc (')', dumpfile);
      if (c->next != NULL)
	fputc (' ', dumpfile);
    }
}
コード例 #2
0
ファイル: show.c プロジェクト: jasonlarkin/disorder
static void show_component(g95_component *c) {

    g95_status("comp(%s, ts=", c->name);
    show_typespec(&c->ts);

    if (c->pointer)
	g95_status(", pointer=1");

    if (c->dimension)
	g95_status(", dimension=1");

    if (c->allocatable)
	g95_status(", allocatable=1");

    if (c->as != NULL) {
	g95_status(", as=");
	show_array_spec(c->as);
    }

    g95_status(")");
}
コード例 #3
0
ファイル: dump-parse-tree.c プロジェクト: ChaosJohn/gcc
static void
show_symbol (gfc_symbol *sym)
{
  gfc_formal_arglist *formal;
  gfc_interface *intr;
  int i,len;

  if (sym == NULL)
    return;

  fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
  len = strlen (sym->name);
  for (i=len; i<12; i++)
    fputc(' ', dumpfile);

  ++show_level;

  show_indent ();
  fputs ("type spec : ", dumpfile);
  show_typespec (&sym->ts);

  show_indent ();
  fputs ("attributes: ", dumpfile);
  show_attr (&sym->attr, sym->module);

  if (sym->value)
    {
      show_indent ();
      fputs ("value: ", dumpfile);
      show_expr (sym->value);
    }

  if (sym->as)
    {
      show_indent ();
      fputs ("Array spec:", dumpfile);
      show_array_spec (sym->as);
    }

  if (sym->generic)
    {
      show_indent ();
      fputs ("Generic interfaces:", dumpfile);
      for (intr = sym->generic; intr; intr = intr->next)
	fprintf (dumpfile, " %s", intr->sym->name);
    }

  if (sym->result)
    {
      show_indent ();
      fprintf (dumpfile, "result: %s", sym->result->name);
    }

  if (sym->components)
    {
      show_indent ();
      fputs ("components: ", dumpfile);
      show_components (sym);
    }

  if (sym->f2k_derived)
    {
      show_indent ();
      if (sym->hash_value)
	fprintf (dumpfile, "hash: %d", sym->hash_value);
      show_f2k_derived (sym->f2k_derived);
    }

  if (sym->formal)
    {
      show_indent ();
      fputs ("Formal arglist:", dumpfile);

      for (formal = sym->formal; formal; formal = formal->next)
	{
	  if (formal->sym != NULL)
	    fprintf (dumpfile, " %s", formal->sym->name);
	  else
	    fputs (" [Alt Return]", dumpfile);
	}
    }

  if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
      && sym->attr.proc != PROC_ST_FUNCTION
      && !sym->attr.entry)
    {
      show_indent ();
      fputs ("Formal namespace", dumpfile);
      show_namespace (sym->formal_ns);
    }
  --show_level;
}
コード例 #4
0
ファイル: dump-parse-tree.c プロジェクト: ChaosJohn/gcc
static void
show_namespace (gfc_namespace *ns)
{
  gfc_interface *intr;
  gfc_namespace *save;
  int op;
  gfc_equiv *eq;
  int i;

  gcc_assert (ns);
  save = gfc_current_ns;

  show_indent ();
  fputs ("Namespace:", dumpfile);

  i = 0;
  do
    {
      int l = i;
      while (i < GFC_LETTERS - 1
	     && gfc_compare_types (&ns->default_type[i+1],
				   &ns->default_type[l]))
	i++;

      if (i > l)
	fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
      else
	fprintf (dumpfile, " %c: ", l+'A');

      show_typespec(&ns->default_type[l]);
      i++;
    } while (i < GFC_LETTERS);

  if (ns->proc_name != NULL)
    {
      show_indent ();
      fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
    }

  ++show_level;
  gfc_current_ns = ns;
  gfc_traverse_symtree (ns->common_root, show_common);

  gfc_traverse_symtree (ns->sym_root, show_symtree);

  for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
    {
      /* User operator interfaces */
      intr = ns->op[op];
      if (intr == NULL)
	continue;

      show_indent ();
      fprintf (dumpfile, "Operator interfaces for %s:",
	       gfc_op2string ((gfc_intrinsic_op) op));

      for (; intr; intr = intr->next)
	fprintf (dumpfile, " %s", intr->sym->name);
    }

  if (ns->uop_root != NULL)
    {
      show_indent ();
      fputs ("User operators:\n", dumpfile);
      gfc_traverse_user_op (ns, show_uop);
    }
  
  for (eq = ns->equiv; eq; eq = eq->next)
    show_equiv (eq);

  fputc ('\n', dumpfile);
  show_indent ();
  fputs ("code:", dumpfile);
  show_code (show_level, ns->code);
  --show_level;

  for (ns = ns->contained; ns; ns = ns->sibling)
    {
      fputs ("\nCONTAINS\n", dumpfile);
      ++show_level;
      show_namespace (ns);
      --show_level;
    }

  fputc ('\n', dumpfile);
  gfc_current_ns = save;
}
コード例 #5
0
ファイル: show.c プロジェクト: jasonlarkin/disorder
void g95_show_namespace(g95_namespace *ns) {
g95_interface *intr;
g95_namespace *save;
int i;

    if (ns == NULL)
	return;

    save = g95_current_ns; 

    show_indent();
    g95_status("ns(");

    for(i=0; i<G95_LETTERS; i++) {
	g95_status("%c=", i+'A');
	show_typespec(&ns->default_type[i]);

	if (i != G95_LETTERS-1)
	    g95_status_char(',');

	g95_status_char((i % 3 == 2) ? '\n' : ' ');
    }

    if (ns->proc_name != NULL)
	g95_status(", name='%s'", ns->proc_name->name);

    g95_status(")\n");

    for(i=0; i<G95_INTRINSIC_OPS; i++) {    /* User operator interfaces */
	intr = ns->operator[i];
	if (intr == NULL)
	    continue;

	g95_status("operator('%s', [", g95_op2string(i));

	for(; intr; intr=intr->next)
	    g95_status(" '%s',", intr->sym->name);

	g95_status("])\n");
    }

    g95_traverse_user_op(ns, show_uop);

    g95_traverse_symtree(ns, g95_clear_sym_mark);

    g95_current_ns = ns;
    g95_traverse_symtree(ns, show_symtree);
    g95_status("\n\n");

    show_code(0, ns->code);
    show_level++; 

    for(ns=ns->contained; ns; ns=ns->sibling) {
	g95_status("# Contains\n");
	g95_show_namespace(ns);
    }

    show_level--;
    g95_status_char('\n');
    g95_current_ns = save;
}
コード例 #6
0
ファイル: show.c プロジェクト: jasonlarkin/disorder
static void show_symbol(g95_symbol *sym) {
g95_formal_arglist *formal;
symbol_attribute *attr;
g95_component *c;

    if (sym == NULL)
	return;

    show_indent();

    g95_status("symbol(%s, ts=", g95_symbol_name(sym));
    show_typespec(&sym->ts);

    attr = &sym->attr;
    g95_status(", flavor='%s'", g95_flavor_string(attr->flavor));

    if (attr->intent != INTENT_UNKNOWN)
	g95_status(", intent='%s'", g95_intent_string(attr->intent));

    if (attr->access != ACCESS_UNKNOWN)
	g95_status(", access='%s'", g95_access_string(attr->access));

    if (attr->proc != PROC_UNKNOWN)
	g95_status(", proc='%s'", g95_procedure_string(attr->proc));

    if (attr->allocatable)
	g95_status(", allocatable=1");

    if (attr->dimension)
	g95_status(", dimension=1");

    if (attr->external)
	g95_status(", external=1");

    if (attr->intrinsic)
	g95_status(", intrinsic=1");

    if (attr->optional)
	g95_status(", optional=1");

    if (attr->pointer)
	g95_status(", pointer=1");

    if (attr->save)
	g95_status(", save=1");

    if (attr->target)
	g95_status(", target=1");

    if (attr->dummy)
	g95_status(", dummy=1");

    if (attr->result_var)
	g95_status(", result=1");

    if (attr->entry)
	g95_status(", entry=1");

    if (attr->data)
	g95_status(", data=1");

    if (attr->use_assoc)
	g95_status(", use_assoc=1");

    if (attr->in_namelist)
	g95_status(", in_namelist=1");

    if (attr->in_common)
	g95_status(", in_common=1");

    if (attr->function)
	g95_status(", function=1");

    if (attr->subroutine)
	g95_status(", subroutine=1");

    if (attr->sequence)
	g95_status(", sequence=1");

    if (attr->elemental)
	g95_status(", elemental=1");

    if (attr->pure)
	g95_status(", pure=1");

    if (attr->recursive)
	g95_status(", recursive=1");

    if (attr->artificial)
	g95_status(", artificial=1");

    if (sym->value) {
	g95_status(", value=");
	g95_show_expr(sym->value);
    }

    if (sym->as != NULL) {
	g95_status(", as=");
	show_array_spec(sym->as);
    }

    if (sym->result)
	g95_status(", result=%s", g95_symbol_name(sym->result));

    if (sym->components) {
	g95_status(", components=[");
	for(c=sym->components; c; c=c->next)
	    show_component(c);

	g95_status("]");
    }

    if (sym->formal) {
	show_indent();
	g95_status("formal=[");

	for(formal=sym->formal; formal; formal=formal->next)
	    if (formal->sym == NULL)
		g95_status("*");
	    else
		g95_status("'%s', ", formal->sym->name);

	g95_status("]");
    }

    g95_status(")\n");
}