flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
This commit is contained in:
Steven G. Kargl
Paul Brook
parent
8930ce20d0
commit
df65f0938c
|
|
@ -1,3 +1,19 @@
|
|||
2004-12-02 Steven G. Kargl <kargls@comcast.net>
|
||||
Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
|
||||
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
|
||||
(gfc_check_stat, gfc_check_stat_sub): New functions.
|
||||
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
|
||||
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
|
||||
fstat, and stat to intrinsics symbol tables.
|
||||
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
|
||||
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
|
||||
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
|
||||
(gfc_resolve_stat, gfc_resolve_flush): New functions.
|
||||
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
|
||||
|
||||
2004-12-02 Steven G. Kargl <kargls@comcast.net>
|
||||
|
||||
* intrinsic.c: Fix and add comments, fix function declarations
|
||||
|
|
|
|||
|
|
@ -750,6 +750,20 @@ gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary,
|
|||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_fnum (gfc_expr * unit)
|
||||
{
|
||||
|
||||
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (unit, 0) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/* This is used for the g77 one-argument Bessel functions, and the
|
||||
error function. */
|
||||
|
||||
|
|
@ -1623,6 +1637,7 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
|
|||
|
||||
if (type_check (ncopies, 2, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (ncopies, 2) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
|
|
@ -1630,6 +1645,104 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
|
|||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_fstat (gfc_expr * unit, gfc_expr * array)
|
||||
{
|
||||
|
||||
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (unit, 0) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (unit, 0, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (array_check (array, 1) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status)
|
||||
{
|
||||
|
||||
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (unit, 0) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (array_check (array, 1) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (status == NULL)
|
||||
return SUCCESS;
|
||||
|
||||
if (type_check (status, 2, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (status, 2) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_stat (gfc_expr * name, gfc_expr * array)
|
||||
{
|
||||
|
||||
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (array_check (array, 1) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_stat_sub (gfc_expr * name, gfc_expr * array, gfc_expr * status)
|
||||
{
|
||||
|
||||
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (array_check (array, 1) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (status == NULL)
|
||||
return SUCCESS;
|
||||
|
||||
if (type_check (status, 2, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (status, 2) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_transfer (gfc_expr * source ATTRIBUTE_UNUSED,
|
||||
gfc_expr * mold ATTRIBUTE_UNUSED,
|
||||
|
|
@ -2138,6 +2251,23 @@ gfc_check_exit (gfc_expr * status)
|
|||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_flush (gfc_expr * unit)
|
||||
{
|
||||
|
||||
if (unit == NULL)
|
||||
return SUCCESS;
|
||||
|
||||
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (scalar_check (unit, 0) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
try
|
||||
gfc_check_umask (gfc_expr * mask)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -315,7 +315,9 @@ enum gfc_generic_isym_id
|
|||
GFC_ISYM_EXP,
|
||||
GFC_ISYM_EXPONENT,
|
||||
GFC_ISYM_FLOOR,
|
||||
GFC_ISYM_FNUM,
|
||||
GFC_ISYM_FRACTION,
|
||||
GFC_ISYM_FSTAT,
|
||||
GFC_ISYM_GETCWD,
|
||||
GFC_ISYM_GETGID,
|
||||
GFC_ISYM_GETPID,
|
||||
|
|
@ -379,6 +381,7 @@ enum gfc_generic_isym_id
|
|||
GFC_ISYM_SPREAD,
|
||||
GFC_ISYM_SQRT,
|
||||
GFC_ISYM_SR_KIND,
|
||||
GFC_ISYM_STAT,
|
||||
GFC_ISYM_SUM,
|
||||
GFC_ISYM_SYSTEM,
|
||||
GFC_ISYM_TAN,
|
||||
|
|
|
|||
|
|
@ -857,7 +857,7 @@ add_functions (void)
|
|||
*s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
|
||||
*x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
|
||||
*y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
|
||||
*z = "z", *ln = "len";
|
||||
*z = "z", *ln = "len", *ut = "unit";
|
||||
|
||||
int di, dr, dd, dl, dc, dz, ii;
|
||||
|
||||
|
|
@ -1280,12 +1280,25 @@ add_functions (void)
|
|||
|
||||
make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
|
||||
|
||||
/* G77 compatible fnum */
|
||||
add_sym_1 ("fnum", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
|
||||
gfc_check_fnum, NULL, gfc_resolve_fnum,
|
||||
ut, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
|
||||
|
||||
add_sym_1 ("fraction", 1, 1, BT_REAL, dr, GFC_STD_F95,
|
||||
gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
|
||||
x, BT_REAL, dr, REQUIRED);
|
||||
|
||||
make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
|
||||
|
||||
add_sym_2 ("fstat", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
|
||||
gfc_check_fstat, NULL, gfc_resolve_fstat,
|
||||
a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
|
||||
|
||||
/* Unix IDs (g77 compatibility) */
|
||||
add_sym_1 ("getcwd", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
|
||||
NULL, NULL, gfc_resolve_getcwd,
|
||||
|
|
@ -1876,6 +1889,12 @@ add_functions (void)
|
|||
|
||||
make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
|
||||
|
||||
add_sym_2 ("stat", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
|
||||
gfc_check_stat, NULL, gfc_resolve_stat,
|
||||
a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
|
||||
|
||||
add_sym_3red ("sum", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95,
|
||||
gfc_check_product_sum, NULL, gfc_resolve_sum,
|
||||
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
|
||||
|
|
@ -1983,7 +2002,7 @@ add_subroutines (void)
|
|||
*f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
|
||||
*com = "command", *length = "length", *st = "status",
|
||||
*val = "value", *num = "number", *name = "name",
|
||||
*trim_name = "trim_name";
|
||||
*trim_name = "trim_name", *ut = "unit";
|
||||
|
||||
int di, dr, dc, dl;
|
||||
|
||||
|
|
@ -2073,6 +2092,20 @@ add_subroutines (void)
|
|||
gfc_check_exit, NULL, gfc_resolve_exit,
|
||||
c, BT_INTEGER, di, OPTIONAL);
|
||||
|
||||
add_sym_1s ("flush", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||
gfc_check_flush, NULL, gfc_resolve_flush,
|
||||
c, BT_INTEGER, di, OPTIONAL);
|
||||
|
||||
add_sym_3s ("fstat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||
gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
|
||||
ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
|
||||
st, BT_INTEGER, di, OPTIONAL);
|
||||
|
||||
add_sym_3s ("stat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||
gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
|
||||
name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
|
||||
st, BT_INTEGER, di, OPTIONAL);
|
||||
|
||||
add_sym_2s ("system", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||
NULL, NULL, gfc_resolve_system_sub,
|
||||
c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@ try gfc_check_digits (gfc_expr *);
|
|||
try gfc_check_dot_product (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_etime (gfc_expr *);
|
||||
try gfc_check_fstat (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_fnum (gfc_expr *);
|
||||
try gfc_check_g77_math1 (gfc_expr *);
|
||||
try gfc_check_huge (gfc_expr *);
|
||||
try gfc_check_i (gfc_expr *);
|
||||
|
|
@ -95,6 +97,7 @@ try gfc_check_size (gfc_expr *, gfc_expr *);
|
|||
try gfc_check_sign (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_srand (gfc_expr *);
|
||||
try gfc_check_stat (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_transpose (gfc_expr *);
|
||||
|
|
@ -112,12 +115,15 @@ try gfc_check_cpu_time (gfc_expr *);
|
|||
try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_exit (gfc_expr *);
|
||||
try gfc_check_flush (gfc_expr *);
|
||||
try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *);
|
||||
try gfc_check_random_number (gfc_expr *);
|
||||
try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_etime_sub (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
try gfc_check_system_sub (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_umask_sub (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_unlink_sub (gfc_expr *, gfc_expr *);
|
||||
|
|
@ -261,7 +267,9 @@ void gfc_resolve_etime_sub (gfc_code *);
|
|||
void gfc_resolve_exp (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_fraction (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_fstat (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_g77_math1 (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_getcwd (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_getgid (gfc_expr *);
|
||||
|
|
@ -315,6 +323,7 @@ void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
|
|||
void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_srand (gfc_code *);
|
||||
void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
void gfc_resolve_system (gfc_expr *, gfc_expr *);
|
||||
|
|
@ -333,6 +342,8 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
|||
/* Intrinsic subroutine resolution. */
|
||||
void gfc_resolve_cpu_time (gfc_code *);
|
||||
void gfc_resolve_exit (gfc_code *);
|
||||
void gfc_resolve_flush (gfc_code *);
|
||||
void gfc_resolve_fstat_sub (gfc_code *);
|
||||
void gfc_resolve_getarg (gfc_code *);
|
||||
void gfc_resolve_getcwd_sub (gfc_code *);
|
||||
void gfc_resolve_get_command (gfc_code *);
|
||||
|
|
@ -340,6 +351,7 @@ void gfc_resolve_get_command_argument (gfc_code *);
|
|||
void gfc_resolve_get_environment_variable (gfc_code *);
|
||||
void gfc_resolve_mvbits (gfc_code *);
|
||||
void gfc_resolve_random_number (gfc_code *);
|
||||
void gfc_resolve_stat_sub (gfc_code *);
|
||||
void gfc_resolve_system_clock (gfc_code *);
|
||||
void gfc_resolve_system_sub (gfc_code *);
|
||||
void gfc_resolve_umask_sub (gfc_code *);
|
||||
|
|
|
|||
|
|
@ -552,6 +552,18 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
|
|||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_fnum (gfc_expr * f, gfc_expr * n)
|
||||
{
|
||||
|
||||
f->ts.type = BT_INTEGER;
|
||||
f->ts.kind = gfc_default_integer_kind;
|
||||
if (n->ts.kind != f->ts.kind)
|
||||
gfc_convert_type (n, &f->ts, 2);
|
||||
f->value.function.name = gfc_get_string (PREFIX("fnum_i%d"), f->ts.kind);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
|
||||
{
|
||||
|
|
@ -1283,6 +1295,32 @@ gfc_resolve_sqrt (gfc_expr * f, gfc_expr * x)
|
|||
}
|
||||
|
||||
|
||||
/* Resolve the g77 compatibility function STAT AND FSTAT. */
|
||||
|
||||
void
|
||||
gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
|
||||
gfc_expr * a ATTRIBUTE_UNUSED)
|
||||
{
|
||||
|
||||
f->ts.type = BT_INTEGER;
|
||||
f->ts.kind = gfc_default_integer_kind;
|
||||
f->value.function.name = gfc_get_string (PREFIX("stat_i%d"), f->ts.kind);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED)
|
||||
{
|
||||
|
||||
f->ts.type = BT_INTEGER;
|
||||
f->ts.kind = gfc_default_integer_kind;
|
||||
if (n->ts.kind != f->ts.kind)
|
||||
gfc_convert_type (n, &f->ts, 2);
|
||||
|
||||
f->value.function.name = gfc_get_string (PREFIX("fstat_i%d"), f->ts.kind);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_expr * mask)
|
||||
|
|
@ -1679,6 +1717,53 @@ gfc_resolve_exit (gfc_code * c)
|
|||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
}
|
||||
|
||||
/* Resolve the FLUSH intrinsic subroutine. */
|
||||
|
||||
void
|
||||
gfc_resolve_flush (gfc_code * c)
|
||||
{
|
||||
const char *name;
|
||||
gfc_typespec ts;
|
||||
gfc_expr *n;
|
||||
|
||||
ts.type = BT_INTEGER;
|
||||
ts.kind = gfc_default_integer_kind;
|
||||
n = c->ext.actual->expr;
|
||||
if (n != NULL
|
||||
&& n->ts.kind != ts.kind)
|
||||
gfc_convert_type (n, &ts, 2);
|
||||
|
||||
name = gfc_get_string (PREFIX("flush_i%d"), ts.kind);
|
||||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
}
|
||||
|
||||
/* Resolve the STAT and FSTAT intrinsic subroutines. */
|
||||
|
||||
void
|
||||
gfc_resolve_stat_sub (gfc_code * c)
|
||||
{
|
||||
const char *name;
|
||||
|
||||
name = gfc_get_string (PREFIX("stat_i%d_sub"), gfc_default_integer_kind);
|
||||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_fstat_sub (gfc_code * c)
|
||||
{
|
||||
const char *name;
|
||||
gfc_expr *u;
|
||||
gfc_typespec *ts;
|
||||
|
||||
u = c->ext.actual->expr;
|
||||
ts = &c->ext.actual->next->expr->ts;
|
||||
if (u->ts.kind != ts->kind)
|
||||
gfc_convert_type (u, ts, 2);
|
||||
name = gfc_get_string (PREFIX("fstat_i%d_sub"), ts->kind);
|
||||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
}
|
||||
|
||||
/* Resolve the UMASK intrinsic subroutine. */
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -2964,15 +2964,18 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
|
|||
break;
|
||||
|
||||
case GFC_ISYM_DOT_PRODUCT:
|
||||
case GFC_ISYM_MATMUL:
|
||||
case GFC_ISYM_IRAND:
|
||||
case GFC_ISYM_RAND:
|
||||
case GFC_ISYM_ETIME:
|
||||
case GFC_ISYM_SECOND:
|
||||
case GFC_ISYM_FNUM:
|
||||
case GFC_ISYM_FSTAT:
|
||||
case GFC_ISYM_GETCWD:
|
||||
case GFC_ISYM_GETGID:
|
||||
case GFC_ISYM_GETPID:
|
||||
case GFC_ISYM_GETUID:
|
||||
case GFC_ISYM_IRAND:
|
||||
case GFC_ISYM_MATMUL:
|
||||
case GFC_ISYM_RAND:
|
||||
case GFC_ISYM_SECOND:
|
||||
case GFC_ISYM_STAT:
|
||||
case GFC_ISYM_SYSTEM:
|
||||
case GFC_ISYM_UMASK:
|
||||
case GFC_ISYM_UNLINK:
|
||||
|
|
|
|||
|
|
@ -1,3 +1,18 @@
|
|||
2004-12-02 Steven G. Kargl <kargls@comcast.net>
|
||||
Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* intrinsics/flush.c: New file.
|
||||
* intrinsics/fnum.c: ditto
|
||||
* intrinsics/stat.c: ditto
|
||||
* io/io.h (unit_to_fd): Add prototype.
|
||||
* io/unix.c (unit_to_fd): New function.
|
||||
* configure.ac: Add test for members of struct stat. Check for
|
||||
sys/types.h and sys/stat.h
|
||||
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
|
||||
* configure.in: Regenerate.
|
||||
* config.h.in: Regenerate.
|
||||
* Makefile.in: Regenerate.
|
||||
|
||||
2004-12-01 Aaron W. LaFramboise <aaronavay62@aaronwl.com>
|
||||
|
||||
* Makefile.am (AM_CPPFLAGS): Use -iquote instead of -I.
|
||||
|
|
|
|||
|
|
@ -53,6 +53,8 @@ intrinsics/eoshift0.c \
|
|||
intrinsics/eoshift2.c \
|
||||
intrinsics/etime.c \
|
||||
intrinsics/exit.c \
|
||||
intrinsics/flush.c \
|
||||
intrinsics/fnum.c \
|
||||
intrinsics/getcwd.c \
|
||||
intrinsics/getXid.c \
|
||||
intrinsics/ishftc.c \
|
||||
|
|
@ -68,6 +70,7 @@ intrinsics/reshape_generic.c \
|
|||
intrinsics/reshape_packed.c \
|
||||
intrinsics/selected_int_kind.f90 \
|
||||
intrinsics/selected_real_kind.f90 \
|
||||
intrinsics/stat.c \
|
||||
intrinsics/system_clock.c \
|
||||
intrinsics/transpose_generic.c \
|
||||
intrinsics/umask.c \
|
||||
|
|
|
|||
|
|
@ -128,12 +128,13 @@ am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
|
|||
am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
|
||||
c99_functions.lo cpu_time.lo cshift0.lo date_and_time.lo \
|
||||
env.lo erf.lo eoshift0.lo eoshift2.lo etime.lo exit.lo \
|
||||
getcwd.lo getXid.lo ishftc.lo mvbits.lo pack_generic.lo \
|
||||
size.lo spread_generic.lo string_intrinsics.lo system.lo \
|
||||
rand.lo random.lo reshape_generic.lo reshape_packed.lo \
|
||||
selected_int_kind.lo selected_real_kind.lo system_clock.lo \
|
||||
transpose_generic.lo umask.lo unlink.lo unpack_generic.lo \
|
||||
in_pack_generic.lo in_unpack_generic.lo normalize.lo
|
||||
flush.lo fnum.lo getcwd.lo getXid.lo ishftc.lo mvbits.lo \
|
||||
pack_generic.lo size.lo spread_generic.lo string_intrinsics.lo \
|
||||
system.lo rand.lo random.lo reshape_generic.lo \
|
||||
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
|
||||
stat.lo system_clock.lo transpose_generic.lo umask.lo \
|
||||
unlink.lo unpack_generic.lo in_pack_generic.lo \
|
||||
in_unpack_generic.lo normalize.lo
|
||||
am__objects_34 =
|
||||
am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
|
||||
_abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
|
||||
|
|
@ -333,6 +334,8 @@ intrinsics/eoshift0.c \
|
|||
intrinsics/eoshift2.c \
|
||||
intrinsics/etime.c \
|
||||
intrinsics/exit.c \
|
||||
intrinsics/flush.c \
|
||||
intrinsics/fnum.c \
|
||||
intrinsics/getcwd.c \
|
||||
intrinsics/getXid.c \
|
||||
intrinsics/ishftc.c \
|
||||
|
|
@ -348,6 +351,7 @@ intrinsics/reshape_generic.c \
|
|||
intrinsics/reshape_packed.c \
|
||||
intrinsics/selected_int_kind.f90 \
|
||||
intrinsics/selected_real_kind.f90 \
|
||||
intrinsics/stat.c \
|
||||
intrinsics/system_clock.c \
|
||||
intrinsics/transpose_generic.c \
|
||||
intrinsics/umask.c \
|
||||
|
|
@ -1224,6 +1228,12 @@ etime.lo: intrinsics/etime.c
|
|||
exit.lo: intrinsics/exit.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c
|
||||
|
||||
flush.lo: intrinsics/flush.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o flush.lo `test -f 'intrinsics/flush.c' || echo '$(srcdir)/'`intrinsics/flush.c
|
||||
|
||||
fnum.lo: intrinsics/fnum.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c
|
||||
|
||||
getcwd.lo: intrinsics/getcwd.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o getcwd.lo `test -f 'intrinsics/getcwd.c' || echo '$(srcdir)/'`intrinsics/getcwd.c
|
||||
|
||||
|
|
@ -1263,6 +1273,9 @@ reshape_generic.lo: intrinsics/reshape_generic.c
|
|||
reshape_packed.lo: intrinsics/reshape_packed.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_packed.lo `test -f 'intrinsics/reshape_packed.c' || echo '$(srcdir)/'`intrinsics/reshape_packed.c
|
||||
|
||||
stat.lo: intrinsics/stat.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o stat.lo `test -f 'intrinsics/stat.c' || echo '$(srcdir)/'`intrinsics/stat.c
|
||||
|
||||
system_clock.lo: intrinsics/system_clock.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system_clock.lo `test -f 'intrinsics/system_clock.c' || echo '$(srcdir)/'`intrinsics/system_clock.c
|
||||
|
||||
|
|
|
|||
|
|
@ -165,6 +165,15 @@
|
|||
/* Define to 1 if you have the `strtof' function. */
|
||||
#undef HAVE_STRTOF
|
||||
|
||||
/* Define to 1 if `st_blksize' is member of `struct stat'. */
|
||||
#undef HAVE_STRUCT_STAT_ST_BLKSIZE
|
||||
|
||||
/* Define to 1 if `st_blocks' is member of `struct stat'. */
|
||||
#undef HAVE_STRUCT_STAT_ST_BLOCKS
|
||||
|
||||
/* Define to 1 if `st_rdev' is member of `struct stat'. */
|
||||
#undef HAVE_STRUCT_STAT_ST_RDEV
|
||||
|
||||
/* Define to 1 if you have the <sys/mman.h> header file. */
|
||||
#undef HAVE_SYS_MMAN_H
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -152,9 +152,13 @@ AC_TYPE_OFF_T
|
|||
AC_STDC_HEADERS
|
||||
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h)
|
||||
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
|
||||
AC_CHECK_HEADERS(sys/mman.h)
|
||||
AC_CHECK_HEADERS(sys/mman.h sys/types.h sys/stat.h)
|
||||
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
|
||||
|
||||
AC_CHECK_MEMBERS([struct stat.st_blksize])
|
||||
AC_CHECK_MEMBERS([struct stat.st_blocks])
|
||||
AC_CHECK_MEMBERS([struct stat.st_rdev])
|
||||
|
||||
# Check for complex math functions
|
||||
AC_CHECK_LIB([m],[csin],[need_math="no"],[need_math="yes"])
|
||||
|
||||
|
|
|
|||
|
|
@ -465,6 +465,8 @@ void empty_internal_buffer(stream *);
|
|||
#define flush prefix(flush)
|
||||
try flush (stream *);
|
||||
|
||||
#define unit_to_fd prefix(unit_to_fd)
|
||||
int unit_to_fd (int);
|
||||
|
||||
/* unit.c */
|
||||
|
||||
|
|
|
|||
|
|
@ -286,7 +286,6 @@ sys_exit (int code)
|
|||
}
|
||||
|
||||
|
||||
|
||||
/*********************************************************************
|
||||
File descriptor stream functions
|
||||
*********************************************************************/
|
||||
|
|
@ -918,6 +917,22 @@ fd_to_stream (int fd, int prot)
|
|||
}
|
||||
|
||||
|
||||
/* Given the Fortran unit number, convert it to a C file descriptor. */
|
||||
|
||||
int
|
||||
unit_to_fd(int unit)
|
||||
{
|
||||
|
||||
gfc_unit *us;
|
||||
|
||||
us = find_unit(unit);
|
||||
if (us == NULL)
|
||||
return -1;
|
||||
|
||||
return ((unix_stream *) us->s)->fd;
|
||||
}
|
||||
|
||||
|
||||
/* unpack_filename()-- Given a fortran string and a pointer to a
|
||||
* buffer that is PATH_MAX characters, convert the fortran string to a
|
||||
* C string in the buffer. Returns nonzero if this is not possible. */
|
||||
|
|
|
|||
Loading…
Reference in New Issue