static int show_ref_cb(const char *path, const unsigned char *sha1, int flag, void *unused)
{
path = strip_namespace(path);
/*
* Advertise refs outside our current namespace as ".have"
* refs, so that the client can use them to minimize data
* transfer but will otherwise ignore them. This happens to
* cover ".have" that are thrown in by add_one_alternate_ref()
* to mark histories that are complete in our alternates as
* well.
*/
if (!path)
path = ".have";
show_ref(path, sha1);
return 0;
}
static int show_ref_cb(const char *path_full, const struct object_id *oid,
int flag, void *unused)
{
const char *path = strip_namespace(path_full);
if (ref_is_hidden(path, path_full))
return 0;
/*
* Advertise refs outside our current namespace as ".have"
* refs, so that the client can use them to minimize data
* transfer but will otherwise ignore them. This happens to
* cover ".have" that are thrown in by add_one_alternate_ref()
* to mark histories that are complete in our alternates as
* well.
*/
if (!path)
path = ".have";
show_ref(path, oid->hash);
return 0;
}
static void
show_expr (gfc_expr *p)
{
const char *c;
int i;
if (p == NULL)
{
fputs ("()", dumpfile);
return;
}
switch (p->expr_type)
{
case EXPR_SUBSTRING:
show_char_const (p->value.character.string, p->value.character.length);
show_ref (p->ref);
break;
case EXPR_STRUCTURE:
fprintf (dumpfile, "%s(", p->ts.u.derived->name);
show_constructor (p->value.constructor);
fputc (')', dumpfile);
break;
case EXPR_ARRAY:
fputs ("(/ ", dumpfile);
show_constructor (p->value.constructor);
fputs (" /)", dumpfile);
show_ref (p->ref);
break;
case EXPR_NULL:
fputs ("NULL()", dumpfile);
break;
case EXPR_CONSTANT:
switch (p->ts.type)
{
case BT_INTEGER:
mpz_out_str (stdout, 10, p->value.integer);
if (p->ts.kind != gfc_default_integer_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
break;
case BT_LOGICAL:
if (p->value.logical)
fputs (".true.", dumpfile);
else
fputs (".false.", dumpfile);
break;
case BT_REAL:
mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
if (p->ts.kind != gfc_default_real_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
break;
case BT_CHARACTER:
show_char_const (p->value.character.string,
p->value.character.length);
break;
case BT_COMPLEX:
fputs ("(complex ", dumpfile);
mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
fputc (' ', dumpfile);
mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
fputc (')', dumpfile);
break;
case BT_HOLLERITH:
fprintf (dumpfile, "%dH", p->representation.length);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
fputc (*c, dumpfile);
}
break;
default:
fputs ("???", dumpfile);
break;
}
if (p->representation.string)
{
fputs (" {", dumpfile);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
fprintf (dumpfile, "%.2x", (unsigned int) *c);
if (i < p->representation.length - 1)
fputc (',', dumpfile);
}
fputc ('}', dumpfile);
}
break;
case EXPR_VARIABLE:
if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
fprintf (dumpfile, "%s", p->symtree->n.sym->name);
show_ref (p->ref);
break;
case EXPR_OP:
fputc ('(', dumpfile);
switch (p->value.op.op)
{
case INTRINSIC_UPLUS:
fputs ("U+ ", dumpfile);
break;
case INTRINSIC_UMINUS:
fputs ("U- ", dumpfile);
break;
case INTRINSIC_PLUS:
fputs ("+ ", dumpfile);
break;
case INTRINSIC_MINUS:
fputs ("- ", dumpfile);
break;
case INTRINSIC_TIMES:
fputs ("* ", dumpfile);
break;
case INTRINSIC_DIVIDE:
fputs ("/ ", dumpfile);
break;
case INTRINSIC_POWER:
fputs ("** ", dumpfile);
break;
case INTRINSIC_CONCAT:
fputs ("// ", dumpfile);
break;
case INTRINSIC_AND:
fputs ("AND ", dumpfile);
break;
case INTRINSIC_OR:
fputs ("OR ", dumpfile);
break;
case INTRINSIC_EQV:
fputs ("EQV ", dumpfile);
break;
case INTRINSIC_NEQV:
fputs ("NEQV ", dumpfile);
break;
case INTRINSIC_EQ:
case INTRINSIC_EQ_OS:
fputs ("= ", dumpfile);
break;
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
fputs ("/= ", dumpfile);
break;
case INTRINSIC_GT:
case INTRINSIC_GT_OS:
fputs ("> ", dumpfile);
break;
case INTRINSIC_GE:
case INTRINSIC_GE_OS:
fputs (">= ", dumpfile);
break;
case INTRINSIC_LT:
case INTRINSIC_LT_OS:
fputs ("< ", dumpfile);
break;
case INTRINSIC_LE:
case INTRINSIC_LE_OS:
fputs ("<= ", dumpfile);
break;
case INTRINSIC_NOT:
fputs ("NOT ", dumpfile);
break;
case INTRINSIC_PARENTHESES:
fputs ("parens ", dumpfile);
break;
default:
gfc_internal_error
("show_expr(): Bad intrinsic in expression!");
}
show_expr (p->value.op.op1);
if (p->value.op.op2)
{
fputc (' ', dumpfile);
show_expr (p->value.op.op2);
}
fputc (')', dumpfile);
break;
case EXPR_FUNCTION:
if (p->value.function.name == NULL)
{
fprintf (dumpfile, "%s", p->symtree->n.sym->name);
if (gfc_is_proc_ptr_comp (p))
show_ref (p->ref);
fputc ('[', dumpfile);
show_actual_arglist (p->value.function.actual);
fputc (']', dumpfile);
}
else
{
fprintf (dumpfile, "%s", p->value.function.name);
if (gfc_is_proc_ptr_comp (p))
show_ref (p->ref);
fputc ('[', dumpfile);
fputc ('[', dumpfile);
show_actual_arglist (p->value.function.actual);
fputc (']', dumpfile);
fputc (']', dumpfile);
}
break;
case EXPR_COMPCALL:
show_compcall (p);
break;
default:
gfc_internal_error ("show_expr(): Don't know how to show expr");
}
}
static void show_one_alternate_sha1(const unsigned char sha1[20], void *unused)
{
show_ref(".have", sha1);
}