New intrinsics: ChDir, IErrNo, Link, Rename, Sleep, and SymLnk
coudert@lcp.u-psud.fr
coudert@lcp.u-psud.fr
Tue Jan 25 23:43:00 GMT 2005
Hi all,
I implemented a few g77 intrinsics. Bootstrapped, regtested and tested all
those new intrinsics on i686-linux. At the end of this mail is the diff in
current state; I will wait for comments before calling it a patch. A few
questions:
* Includes are protected with the #ifdef HAVE_FOO_H mechanism. Should I
protect function calls (like, say, "sleep" or "link", which may not exist
on exotic platforms)? How could I do that?
* For a subroutine like kill (not yet implemented), which has 3 integers
arguments, should I implement kill_i4_i4_i4 and all other 7 possibilities
or use m4 (which I don't yet really understand, but I'll work on that)?
Thanks,
FX
2005-01-25 François-Xavier Coudert <coudert@clipper.ens.fr>
* chdir.c, ierrno.c, link.c, rename.c, sleep.c, symlnk.c,
Makefile.am, check.c, gfortran.h, intrinsic.c, intrinsic.h,
iresolve.c, trans-intrinsic.c: Added ChDir, IErrNo, Link, Rename,
Sleep, and SymLnk intrinsics.
? intrinsics/chdir.c
? intrinsics/ierrno.c
? intrinsics/link.c
? intrinsics/rename.c
? intrinsics/sleep.c
? intrinsics/symlnk.c
Index: Makefile.am
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.29
diff -c -5 -r1.29 Makefile.am
*** Makefile.am 23 Jan 2005 17:00:58 -0000 1.29
--- Makefile.am 25 Jan 2005 23:17:10 -0000
***************
*** 42,51 ****
--- 42,52 ----
intrinsics/associated.c \
intrinsics/abort.c \
intrinsics/args.c \
intrinsics/bessel.c \
intrinsics/c99_functions.c \
+ intrinsics/chdir.c \
intrinsics/cpu_time.c \
intrinsics/cshift0.c \
intrinsics/date_and_time.c \
intrinsics/env.c \
intrinsics/erf.c \
***************
*** 55,78 ****
--- 56,84 ----
intrinsics/exit.c \
intrinsics/flush.c \
intrinsics/fnum.c \
intrinsics/getcwd.c \
intrinsics/getXid.c \
+ intrinsics/ierrno.c \
intrinsics/ishftc.c \
+ intrinsics/link.c \
intrinsics/mvbits.c \
intrinsics/pack_generic.c \
intrinsics/size.c \
+ intrinsics/sleep.c \
intrinsics/spread_generic.c \
intrinsics/string_intrinsics.c \
intrinsics/system.c \
intrinsics/rand.c \
intrinsics/random.c \
+ intrinsics/rename.c \
intrinsics/reshape_generic.c \
intrinsics/reshape_packed.c \
intrinsics/selected_int_kind.f90 \
intrinsics/selected_real_kind.f90 \
intrinsics/stat.c \
+ intrinsics/symlnk.c \
intrinsics/system_clock.c \
intrinsics/transpose_generic.c \
intrinsics/umask.c \
intrinsics/unlink.c \
intrinsics/unpack_generic.c \
Index: check.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.22
diff -c -5 -r1.22 check.c
*** check.c 18 Jan 2005 12:11:45 -0000 1.22
--- check.c 25 Jan 2005 23:18:24 -0000
***************
*** 548,557 ****
--- 548,586 ----
return SUCCESS;
}
try
+ gfc_check_chdir (gfc_expr * dir)
+ {
+ if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
+ gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status)
+ {
+ if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (status == NULL)
+ return SUCCESS;
+
+ if (type_check (status, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (status, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{
if (numeric_check (x, 0) == FAILURE)
return FAILURE;
***************
*** 968,977 ****
--- 997,1076 ----
return SUCCESS;
}
try
+ gfc_check_link (gfc_expr * path1, gfc_expr * path2)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
+ gfc_check_link_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (status == NULL)
+ return SUCCESS;
+
+ if (type_check (status, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (status, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
+ gfc_check_symlnk (gfc_expr * path1, gfc_expr * path2)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
+ gfc_check_symlnk_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (status == NULL)
+ return SUCCESS;
+
+ if (type_check (status, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (status, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
gfc_check_logical (gfc_expr * a, gfc_expr * kind)
{
if (type_check (a, 0, BT_LOGICAL) == FAILURE)
return FAILURE;
if (kind_check (kind, 1, BT_LOGICAL) == FAILURE)
***************
*** 1383,1392 ****
--- 1482,1526 ----
return SUCCESS;
}
try
+ gfc_check_rename (gfc_expr * path1, gfc_expr * path2)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
+ gfc_check_rename_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+ {
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (status == NULL)
+ return SUCCESS;
+
+ if (type_check (status, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (status, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
gfc_check_repeat (gfc_expr * x, gfc_expr * y)
{
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
***************
*** 1573,1582 ****
--- 1707,1729 ----
return SUCCESS;
}
try
+ gfc_check_sleep_sub (gfc_expr * seconds)
+ {
+ if (type_check (seconds, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (seconds, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ try
gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
{
if (source->rank >= GFC_MAX_DIMENSIONS)
{
must_be (source, 0, "less than rank " stringize (GFC_MAX_DIMENSIONS));
Index: gfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.51
diff -c -5 -r1.51 gfortran.h
*** gfortran.h 22 Jan 2005 18:23:40 -0000 1.51
--- gfortran.h 25 Jan 2005 23:18:24 -0000
***************
*** 290,299 ****
--- 290,300 ----
GFC_ISYM_Y1,
GFC_ISYM_YN,
GFC_ISYM_BTEST,
GFC_ISYM_CEILING,
GFC_ISYM_CHAR,
+ GFC_ISYM_CHDIR,
GFC_ISYM_CMPLX,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_CONJG,
GFC_ISYM_COS,
GFC_ISYM_COSH,
***************
*** 323,341 ****
--- 324,344 ----
GFC_ISYM_IBCLR,
GFC_ISYM_IBITS,
GFC_ISYM_IBSET,
GFC_ISYM_ICHAR,
GFC_ISYM_IEOR,
+ GFC_ISYM_IERRNO,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_IOR,
GFC_ISYM_IRAND,
GFC_ISYM_ISHFT,
GFC_ISYM_ISHFTC,
GFC_ISYM_LBOUND,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
+ GFC_ISYM_LINK,
GFC_ISYM_LGE,
GFC_ISYM_LGT,
GFC_ISYM_LLE,
GFC_ISYM_LLT,
GFC_ISYM_LOG,
***************
*** 357,366 ****
--- 360,370 ----
GFC_ISYM_PACK,
GFC_ISYM_PRESENT,
GFC_ISYM_PRODUCT,
GFC_ISYM_RAND,
GFC_ISYM_REAL,
+ GFC_ISYM_RENAME,
GFC_ISYM_REPEAT,
GFC_ISYM_RESHAPE,
GFC_ISYM_RRSPACING,
GFC_ISYM_SCALE,
GFC_ISYM_SCAN,
***************
*** 376,385 ****
--- 380,390 ----
GFC_ISYM_SPREAD,
GFC_ISYM_SQRT,
GFC_ISYM_SR_KIND,
GFC_ISYM_STAT,
GFC_ISYM_SUM,
+ GFC_ISYM_SYMLNK,
GFC_ISYM_SYSTEM,
GFC_ISYM_TAN,
GFC_ISYM_TANH,
GFC_ISYM_TRANSFER,
GFC_ISYM_TRANSPOSE,
Index: intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.37
diff -c -5 -r1.37 intrinsic.c
*** intrinsic.c 22 Jan 2005 22:32:06 -0000 1.37
--- intrinsic.c 25 Jan 2005 23:18:24 -0000
***************
*** 1088,1097 ****
--- 1088,1103 ----
gfc_check_char, gfc_simplify_char, gfc_resolve_char,
i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
+ add_sym_1 ("chdir", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_chdir, NULL, gfc_resolve_chdir,
+ a, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
+
add_sym_3 ("cmplx", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
kind, BT_INTEGER, di, OPTIONAL);
***************
*** 1379,1388 ****
--- 1385,1399 ----
gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
+ add_sym_0 ("ierrno", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+ NULL, NULL, gfc_resolve_ierrno);
+
+ make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
+
add_sym_3 ("index", 1, 1, BT_INTEGER, di, GFC_STD_F77,
gfc_check_index, gfc_simplify_index, NULL,
stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
bck, BT_LOGICAL, dl, OPTIONAL);
***************
*** 1474,1483 ****
--- 1485,1500 ----
NULL, gfc_simplify_llt, NULL,
sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
+ add_sym_2 ("link", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_link, NULL, gfc_resolve_link,
+ a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
+
add_sym_1 ("log", 1, 1, BT_REAL, dr, GFC_STD_F77,
NULL, gfc_simplify_log, gfc_resolve_log,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("alog", 1, 1, BT_REAL, dr, GFC_STD_F77,
***************
*** 1740,1749 ****
--- 1757,1772 ----
NULL, gfc_simplify_sngl, NULL,
a, BT_REAL, dd, REQUIRED);
make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+ add_sym_2 ("rename", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_rename, NULL, gfc_resolve_rename,
+ a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
+
add_sym_2 ("repeat", 0, 1, BT_CHARACTER, dc, GFC_STD_F95,
gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED);
make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
***************
*** 1900,1909 ****
--- 1923,1938 ----
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL);
make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
+ add_sym_2 ("symlnk", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_symlnk, NULL, gfc_resolve_symlnk,
+ a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
+
add_sym_1 ("system", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
NULL, NULL, NULL,
c, BT_CHARACTER, dc, REQUIRED);
make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
***************
*** 2020,2029 ****
--- 2049,2062 ----
/* More G77 compatibility garbage. */
add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_second_sub, NULL, gfc_resolve_second_sub,
tm, BT_REAL, dr, REQUIRED);
+ add_sym_2s ("chdir", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
+ name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
add_sym_4s ("date_and_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95,
gfc_check_date_and_time, NULL, NULL,
dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
***************
*** 2094,2113 ****
--- 2127,2165 ----
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 ("link", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_link_sub, NULL, gfc_resolve_link_sub,
+ name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+ dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+ add_sym_3s ("rename", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
+ name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+ dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+ add_sym_1s ("sleep", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
+ val, BT_CHARACTER, dc, REQUIRED);
+
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_3s ("symlnk", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
+ name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+ dc, 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);
add_sym_3s ("system_clock", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95,
Index: intrinsic.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.20
diff -c -5 -r1.20 intrinsic.h
*** intrinsic.h 2 Dec 2004 04:10:24 -0000 1.20
--- intrinsic.h 25 Jan 2005 23:18:24 -0000
***************
*** 36,45 ****
--- 36,46 ----
try gfc_check_associated (gfc_expr *, gfc_expr *);
try gfc_check_atan2 (gfc_expr *, gfc_expr *);
try gfc_check_besn (gfc_expr *, gfc_expr *);
try gfc_check_btest (gfc_expr *, gfc_expr *);
try gfc_check_char (gfc_expr *, gfc_expr *);
+ try gfc_check_chdir (gfc_expr *);
try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_count (gfc_expr *, gfc_expr *);
try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
try gfc_check_dble (gfc_expr *);
***************
*** 64,73 ****
--- 65,75 ----
try gfc_check_irand (gfc_expr *);
try gfc_check_ishft (gfc_expr *, gfc_expr *);
try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_kind (gfc_expr *);
try gfc_check_lbound (gfc_expr *, gfc_expr *);
+ try gfc_check_link (gfc_expr *, gfc_expr *);
try gfc_check_logical (gfc_expr *, gfc_expr *);
try gfc_check_min_max (gfc_actual_arglist *);
try gfc_check_min_max_integer (gfc_actual_arglist *);
try gfc_check_min_max_real (gfc_actual_arglist *);
try gfc_check_min_max_double (gfc_actual_arglist *);
***************
*** 83,92 ****
--- 85,95 ----
try gfc_check_product_sum (gfc_actual_arglist *);
try gfc_check_radix (gfc_expr *);
try gfc_check_rand (gfc_expr *);
try gfc_check_range (gfc_expr *);
try gfc_check_real (gfc_expr *, gfc_expr *);
+ try gfc_check_rename (gfc_expr *, gfc_expr *);
try gfc_check_repeat (gfc_expr *, gfc_expr *);
try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_scale (gfc_expr *, gfc_expr *);
try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_second_sub (gfc_expr *);
***************
*** 97,106 ****
--- 100,110 ----
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_symlnk (gfc_expr *, gfc_expr *);
try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_transpose (gfc_expr *);
try gfc_check_trim (gfc_expr *);
try gfc_check_ubound (gfc_expr *, gfc_expr *);
try gfc_check_umask (gfc_expr *);
***************
*** 109,118 ****
--- 113,123 ----
try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_x (gfc_expr *);
/* Intrinsic subroutines. */
+ try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
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 *);
***************
*** 121,130 ****
--- 126,139 ----
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_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+ try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+ try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+ try gfc_check_sleep_sub (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 *);
***************
*** 248,257 ****
--- 257,267 ----
void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
+ void gfc_resolve_chdir (gfc_expr *, gfc_expr *);
void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_conjg (gfc_expr *, gfc_expr *);
void gfc_resolve_cos (gfc_expr *, gfc_expr *);
void gfc_resolve_cosh (gfc_expr *, gfc_expr *);
***************
*** 277,296 ****
--- 287,308 ----
void gfc_resolve_getuid (gfc_expr *);
void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
+ void gfc_resolve_ierrno (gfc_expr *);
void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ichar (gfc_expr *, gfc_expr *);
void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_len (gfc_expr *, gfc_expr *);
void gfc_resolve_len_trim (gfc_expr *, gfc_expr *);
+ void gfc_resolve_link (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_log (gfc_expr *, gfc_expr *);
void gfc_resolve_log10 (gfc_expr *, gfc_expr *);
void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *);
***************
*** 306,315 ****
--- 318,328 ----
void gfc_resolve_nint (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_not (gfc_expr *, gfc_expr *);
void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_product (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_real (gfc_expr *, gfc_expr *, gfc_expr *);
+ void gfc_resolve_rename (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_repeat (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
void gfc_resolve_rrspacing (gfc_expr *, gfc_expr *);
void gfc_resolve_scale (gfc_expr *, gfc_expr *, gfc_expr *);
***************
*** 324,333 ****
--- 337,347 ----
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_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_system (gfc_expr *, gfc_expr *);
void gfc_resolve_tan (gfc_expr *, gfc_expr *);
void gfc_resolve_tanh (gfc_expr *, gfc_expr *);
void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_transpose (gfc_expr *, gfc_expr *);
***************
*** 338,347 ****
--- 352,362 ----
void gfc_resolve_unpack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
/* Intrinsic subroutine resolution. */
+ void gfc_resolve_chdir_sub (gfc_code *);
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 *);
***************
*** 349,358 ****
--- 364,377 ----
void gfc_resolve_get_command (gfc_code *);
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_rename_sub (gfc_code *);
+ void gfc_resolve_link_sub (gfc_code *);
+ void gfc_resolve_symlnk_sub (gfc_code *);
+ void gfc_resolve_sleep_sub (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 *);
void gfc_resolve_unlink_sub (gfc_code *);
Index: iresolve.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.31
diff -c -5 -r1.31 iresolve.c
*** iresolve.c 23 Jan 2005 17:00:57 -0000 1.31
--- iresolve.c 25 Jan 2005 23:18:24 -0000
***************
*** 251,260 ****
--- 251,285 ----
gfc_type_letter (a->ts.type), a->ts.kind);
}
void
+ gfc_resolve_chdir (gfc_expr * f, gfc_expr * d ATTRIBUTE_UNUSED)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("chdir_i%d"), f->ts.kind);
+ }
+
+
+ void
+ gfc_resolve_chdir_sub (gfc_code * c)
+ {
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->expr != NULL)
+ kind = c->ext.actual->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("chdir_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ }
+
+
+ void
gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr *
kind)
{
f->ts.type = BT_COMPLEX;
f->ts.kind = (kind == NULL) ? gfc_default_real_kind
: mpz_get_si (kind->value.integer);
***************
*** 594,603 ****
--- 619,637 ----
gfc_resolve_nint (f, a, NULL);
}
void
+ gfc_resolve_ierrno (gfc_expr * f)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("ierrno_i%d"),
f->ts.kind);
+ }
+
+
+ void
gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
{
/* If the kind of i and j are different, then g77 cross-promoted the
kinds to the largest value. The Fortran 95 standard requires the
kinds to match. */
***************
*** 706,715 ****
--- 740,759 ----
f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind);
}
void
+ gfc_resolve_link (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("link_i%d"), f->ts.kind);
+ }
+
+
+ void
gfc_resolve_log (gfc_expr * f, gfc_expr * x)
{
f->ts = x->ts;
f->value.function.name =
gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
***************
*** 1017,1026 ****
--- 1061,1080 ----
gfc_type_letter (a->ts.type), a->ts.kind);
}
void
+ gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("rename_i%d"),
f->ts.kind);
+ }
+
+
+ void
gfc_resolve_repeat (gfc_expr * f, gfc_expr * string,
gfc_expr * ncopies ATTRIBUTE_UNUSED)
{
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
***************
*** 1273,1282 ****
--- 1327,1346 ----
gfc_get_string (PREFIX("%s_%c%d"), mask ? "msum" : "sum",
gfc_type_letter (array->ts.type), array->ts.kind);
}
+ void
+ gfc_resolve_symlnk (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("symlnk_i%d"),
f->ts.kind);
+ }
+
+
/* Resolve the g77 compatibility function SYSTEM. */
void
gfc_resolve_system (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
{
***************
*** 1488,1497 ****
--- 1552,1609 ----
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
+ void
+ gfc_resolve_rename_sub (gfc_code * c)
+ {
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("rename_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ }
+
+
+ void
+ gfc_resolve_link_sub (gfc_code * c)
+ {
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("link_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ }
+
+
+ void
+ gfc_resolve_symlnk_sub (gfc_code * c)
+ {
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("symlnk_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ }
+
+
/* G77 compatibility subroutines etime() and dtime(). */
void
gfc_resolve_etime_sub (gfc_code * c)
{
***************
*** 1512,1521 ****
--- 1624,1649 ----
name = gfc_get_string (PREFIX("second_sub"));
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
+ void
+ gfc_resolve_sleep_sub (gfc_code * c)
+ {
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->expr != NULL)
+ kind = c->ext.actual->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("sleep_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ }
+
+
/* G77 compatibility function srand(). */
void
gfc_resolve_srand (gfc_code * c)
{
Index: trans-intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.43
diff -c -5 -r1.43 trans-intrinsic.c
*** trans-intrinsic.c 23 Jan 2005 14:36:25 -0000 1.43
--- trans-intrinsic.c 25 Jan 2005 23:18:25 -0000
***************
*** 2978,3000 ****
--- 2978,3005 ----
case GFC_ISYM_UBOUND:
gfc_conv_intrinsic_bound (se, expr, 1);
break;
+ case GFC_ISYM_CHDIR:
case GFC_ISYM_DOT_PRODUCT:
case GFC_ISYM_ETIME:
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_IERRNO:
case GFC_ISYM_IRAND:
+ case GFC_ISYM_LINK:
case GFC_ISYM_MATMUL:
case GFC_ISYM_RAND:
+ case GFC_ISYM_RENAME:
case GFC_ISYM_SECOND:
case GFC_ISYM_STAT:
+ case GFC_ISYM_SYMLNK:
case GFC_ISYM_SYSTEM:
case GFC_ISYM_UMASK:
case GFC_ISYM_UNLINK:
gfc_conv_intrinsic_funcall (se, expr);
break;
-------------- next part --------------
A non-text attachment was scrubbed...
Name: chdir.c
Type: text/x-csrc
Size: 3250 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: ierrno.c
Type: text/x-csrc
Size: 1812 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment-0001.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: link.c
Type: text/x-csrc
Size: 4107 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment-0002.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: rename.c
Type: text/x-csrc
Size: 4093 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment-0003.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: sleep.c
Type: text/x-csrc
Size: 2124 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment-0004.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: symlnk.c
Type: text/x-csrc
Size: 4149 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20050125/4d7340ba/attachment-0005.bin>
More information about the Fortran
mailing list