This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
Attached patch adds correct dependencies for libgfortran (on io/io.h and libgfortran.h). The ChangeLog is probably very hard to read, because I had to move many small things to:
- ensure a real separation between io/ and other directories, i.e. io/io.h is only included in io/*.c files; other prototypes and macro definitions are now in libgfortran.h. This includes moving the st_printf function into io/unix.c, because it needs access to the internals of the I/O system. It also includes moving the I/O-related intrinsics (FTELL, FGET, ISATTY, TTYNAM & FLUSH) into a new io/intrinsics.c file, since they also need to access the I/O system internals.
- add dependencies to Makefile.am: all io/*.c files depend on io/io.h; all libgfortran source files depend on libgfortran.h. (Of course, we also need to adjust the different files that were created/deleted).
The patch was bootstrapped and is being regtested on i686-linux. Opinions and comments welcome, especially from libgfortran specialists (Jerry, Thomas, Janne). OK for mainline? (don't be afraid, even when approved, I'll still wait for a few days to let people comment)
Attachment:
libgfortran_dependencies.ChangeLog
Description: Binary data
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am (revision 120583)
+++ libgfortran/Makefile.am (working copy)
@@ -25,6 +25,7 @@
io/file_pos.c \
io/format.c \
io/inquire.c \
+io/intrinsics.c \
io/list_read.c \
io/lock.c \
io/open.c \
@@ -56,10 +57,7 @@
intrinsics/eoshift2.c \
intrinsics/etime.c \
intrinsics/exit.c \
-intrinsics/fget.c \
-intrinsics/flush.c \
intrinsics/fnum.c \
-intrinsics/ftell.c \
intrinsics/gerror.c \
intrinsics/getcwd.c \
intrinsics/getlog.c \
@@ -92,7 +90,6 @@
intrinsics/system_clock.c \
intrinsics/time.c \
intrinsics/transpose_generic.c \
-intrinsics/tty.c \
intrinsics/umask.c \
intrinsics/unlink.c \
intrinsics/unpack_generic.c \
@@ -109,8 +106,7 @@
runtime/pause.c \
runtime/stop.c \
runtime/string.c \
-runtime/select.c \
-libgfortran.h
+runtime/select.c
i_all_c= \
generated/all_l4.c \
@@ -610,6 +606,11 @@
I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
+# Dependencies on io/io.h and libgfortran.h
+$(patsubst %.c,%.lo,$(notdir $(gfor_io_src))): $(gfor_io_headers)
+$(patsubst %.c,%.lo,$(notdir $(libgfortran_la_SOURCES))): libgfortran.h
+
+
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
Index: libgfortran/runtime/environ.c
===================================================================
--- libgfortran/runtime/environ.c (revision 120583)
+++ libgfortran/runtime/environ.c (working copy)
@@ -34,9 +34,7 @@
#include <ctype.h>
#include "libgfortran.h"
-#include "../io/io.h"
-
/* Environment scanner. Examine the environment for controlling minor
* aspects of the program's execution. Our philosophy here that the
* environment should not prevent the program from running, so an
Index: libgfortran/runtime/string.c
===================================================================
--- libgfortran/runtime/string.c (revision 120583)
+++ libgfortran/runtime/string.c (working copy)
@@ -31,7 +31,6 @@
#include <string.h>
#include "libgfortran.h"
-#include "../io/io.h"
/* Compare a C-style string with a fortran style string in a case-insensitive
manner. Used for decoding string options to various statements. Returns
@@ -44,7 +43,7 @@
/* Strip trailing blanks from the Fortran string. */
len = fstrlen (s1, s1_len);
- if(len != strlen(s2)) return 0; /* don't match */
+ if (len != (int) strlen(s2)) return 0; /* don't match */
return strncasecmp (s1, s2, len) == 0;
}
Index: libgfortran/runtime/error.c
===================================================================
--- libgfortran/runtime/error.c (revision 120583)
+++ libgfortran/runtime/error.c (working copy)
@@ -37,8 +37,6 @@
#include <errno.h>
#include "libgfortran.h"
-#include "../io/io.h"
-#include "../io/unix.h"
/* Error conditions. The tricky part here is printing a message when
* it is the I/O subsystem that is severely wounded. Our goal is to
@@ -122,104 +120,6 @@
}
-/* st_printf()-- simple printf() function for streams that handles the
- * formats %d, %s and %c. This function handles printing of error
- * messages that originate within the library itself, not from a user
- * program. */
-
-int
-st_printf (const char *format, ...)
-{
- int count, total;
- va_list arg;
- char *p;
- const char *q;
- stream *s;
- char itoa_buf[GFC_ITOA_BUF_SIZE];
- unix_stream err_stream;
-
- total = 0;
- s = init_error_stream (&err_stream);
- va_start (arg, format);
-
- for (;;)
- {
- count = 0;
-
- while (format[count] != '%' && format[count] != '\0')
- count++;
-
- if (count != 0)
- {
- p = salloc_w (s, &count);
- memmove (p, format, count);
- sfree (s);
- }
-
- total += count;
- format += count;
- if (*format++ == '\0')
- break;
-
- switch (*format)
- {
- case 'c':
- count = 1;
-
- p = salloc_w (s, &count);
- *p = (char) va_arg (arg, int);
-
- sfree (s);
- break;
-
- case 'd':
- q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case 'x':
- q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case 's':
- q = va_arg (arg, char *);
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case '\0':
- return total;
-
- default:
- count = 2;
- p = salloc_w (s, &count);
- p[0] = format[-1];
- p[1] = format[0];
- sfree (s);
- break;
- }
-
- total += count;
- format++;
- }
-
- va_end (arg);
- return total;
-}
-
-
/* st_sprintf()-- Simple sprintf() for formatting memory buffers. */
void
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h (revision 120583)
+++ libgfortran/libgfortran.h (working copy)
@@ -67,6 +67,7 @@
#define __attribute__(x)
#endif
+
/* For a library, a standard prefix is a requirement in order to partition
the namespace. IPREFIX is for symbols intended to be internal to the
library. */
@@ -469,13 +470,68 @@
#define gfc_alloca(x) __builtin_alloca(x)
+/* Various I/O stuff also used in other parts of the library. */
+
+#define DEFAULT_TEMPDIR "/tmp"
+
+/* The default value of record length for preconnected units is defined
+ here. This value can be overriden by an environment variable.
+ Default value is 1 Gb. */
+#define DEFAULT_RECL 1073741824
+
+typedef enum
+{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+unit_convert;
+
+#define CHARACTER2(name) \
+ gfc_charlen_type name ## _len; \
+ char * name
+
+typedef struct st_parameter_common
+{
+ GFC_INTEGER_4 flags;
+ GFC_INTEGER_4 unit;
+ const char *filename;
+ GFC_INTEGER_4 line;
+ CHARACTER2 (iomsg);
+ GFC_INTEGER_4 *iostat;
+}
+st_parameter_common;
+
+#undef CHARACTER2
+
+#define IOPARM_LIBRETURN_MASK (3 << 0)
+#define IOPARM_LIBRETURN_OK (0 << 0)
+#define IOPARM_LIBRETURN_ERROR (1 << 0)
+#define IOPARM_LIBRETURN_END (2 << 0)
+#define IOPARM_LIBRETURN_EOR (3 << 0)
+#define IOPARM_ERR (1 << 2)
+#define IOPARM_END (1 << 3)
+#define IOPARM_EOR (1 << 4)
+#define IOPARM_HAS_IOSTAT (1 << 5)
+#define IOPARM_HAS_IOMSG (1 << 6)
+
+#define IOPARM_COMMON_MASK ((1 << 7) - 1)
+
+#define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
+#define IOPARM_OPEN_HAS_FILE (1 << 8)
+#define IOPARM_OPEN_HAS_STATUS (1 << 9)
+#define IOPARM_OPEN_HAS_ACCESS (1 << 10)
+#define IOPARM_OPEN_HAS_FORM (1 << 11)
+#define IOPARM_OPEN_HAS_BLANK (1 << 12)
+#define IOPARM_OPEN_HAS_POSITION (1 << 13)
+#define IOPARM_OPEN_HAS_ACTION (1 << 14)
+#define IOPARM_OPEN_HAS_DELIM (1 << 15)
+#define IOPARM_OPEN_HAS_PAD (1 << 16)
+#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
+
+
/* main.c */
extern void stupid_function_name_for_static_linking (void);
internal_proto(stupid_function_name_for_static_linking);
-struct st_parameter_common;
-extern void library_start (struct st_parameter_common *);
+extern void library_start (st_parameter_common *);
internal_proto(library_start);
#define library_end()
@@ -502,13 +558,13 @@
extern void os_error (const char *) __attribute__ ((noreturn));
internal_proto(os_error);
-extern void show_locus (struct st_parameter_common *);
+extern void show_locus (st_parameter_common *);
internal_proto(show_locus);
extern void runtime_error (const char *) __attribute__ ((noreturn));
iexport_proto(runtime_error);
-extern void internal_error (struct st_parameter_common *, const char *)
+extern void internal_error (st_parameter_common *, const char *)
__attribute__ ((noreturn));
internal_proto(internal_error);
@@ -518,10 +574,6 @@
extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit);
-extern int st_printf (const char *, ...)
- __attribute__ ((format (printf, 1, 2)));
-internal_proto(st_printf);
-
extern void st_sprintf (char *, const char *, ...)
__attribute__ ((format (printf, 2, 3)));
internal_proto(st_sprintf);
@@ -529,12 +581,15 @@
extern const char *translate_error (int);
internal_proto(translate_error);
-extern void generate_error (struct st_parameter_common *, int, const char *);
+extern void generate_error (st_parameter_common *, int, const char *);
internal_proto(generate_error);
-extern try notify_std (struct st_parameter_common *, int, const char *);
+extern try notify_std (st_parameter_common *, int, const char *);
internal_proto(notify_std);
+extern notification notification_std(int);
+internal_proto(notification_std);
+
/* fpu.c */
extern void set_fpu (void);
@@ -565,9 +620,12 @@
extern void show_variables (void);
internal_proto(show_variables);
+unit_convert get_unformatted_convert (int);
+internal_proto(get_unformatted_convert);
+
/* string.c */
-extern int find_option (struct st_parameter_common *, const char *, int,
+extern int find_option (st_parameter_common *, const char *, int,
const st_option *, const char *);
internal_proto(find_option);
@@ -591,6 +649,10 @@
extern int unit_to_fd (int);
internal_proto(unit_to_fd);
+extern int st_printf (const char *, ...)
+ __attribute__ ((format (printf, 1, 2)));
+internal_proto(st_printf);
+
/* stop.c */
extern void stop_numeric (GFC_INTEGER_4);
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h (revision 120583)
+++ libgfortran/io/io.h (working copy)
@@ -35,8 +35,6 @@
#include <gthr.h>
-#define DEFAULT_TEMPDIR "/tmp"
-
/* Basic types used in data transfers. */
typedef enum
@@ -205,10 +203,6 @@
{READING, WRITING}
unit_mode;
-typedef enum
-{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
-unit_convert;
-
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
@@ -216,42 +210,6 @@
gfc_charlen_type name ## _len; \
char * name
-#define IOPARM_LIBRETURN_MASK (3 << 0)
-#define IOPARM_LIBRETURN_OK (0 << 0)
-#define IOPARM_LIBRETURN_ERROR (1 << 0)
-#define IOPARM_LIBRETURN_END (2 << 0)
-#define IOPARM_LIBRETURN_EOR (3 << 0)
-#define IOPARM_ERR (1 << 2)
-#define IOPARM_END (1 << 3)
-#define IOPARM_EOR (1 << 4)
-#define IOPARM_HAS_IOSTAT (1 << 5)
-#define IOPARM_HAS_IOMSG (1 << 6)
-
-#define IOPARM_COMMON_MASK ((1 << 7) - 1)
-
-typedef struct st_parameter_common
-{
- GFC_INTEGER_4 flags;
- GFC_INTEGER_4 unit;
- const char *filename;
- GFC_INTEGER_4 line;
- CHARACTER2 (iomsg);
- GFC_INTEGER_4 *iostat;
-}
-st_parameter_common;
-
-#define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
-#define IOPARM_OPEN_HAS_FILE (1 << 8)
-#define IOPARM_OPEN_HAS_STATUS (1 << 9)
-#define IOPARM_OPEN_HAS_ACCESS (1 << 10)
-#define IOPARM_OPEN_HAS_FORM (1 << 11)
-#define IOPARM_OPEN_HAS_BLANK (1 << 12)
-#define IOPARM_OPEN_HAS_POSITION (1 << 13)
-#define IOPARM_OPEN_HAS_ACTION (1 << 14)
-#define IOPARM_OPEN_HAS_DELIM (1 << 15)
-#define IOPARM_OPEN_HAS_PAD (1 << 16)
-#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
-
typedef struct
{
st_parameter_common common;
@@ -475,13 +433,6 @@
unit_flags;
-/* The default value of record length for preconnected units is defined
- here. This value can be overriden by an environment variable.
- Default value is 1 Gb. */
-
-#define DEFAULT_RECL 1073741824
-
-
typedef struct gfc_unit
{
int unit_number;
@@ -877,10 +828,6 @@
size_t);
internal_proto(list_formatted_write);
-/* error.c */
-extern notification notification_std(int);
-internal_proto(notification_std);
-
/* size_from_kind.c */
extern size_t size_from_real_kind (int);
internal_proto(size_from_real_kind);
@@ -926,7 +873,3 @@
#endif
-/* ../runtime/environ.c This is here because we return unit_convert. */
-
-unit_convert get_unformatted_convert (int);
-internal_proto(get_unformatted_convert);
Index: libgfortran/io/unix.c
===================================================================
--- libgfortran/io/unix.c (revision 120583)
+++ libgfortran/io/unix.c (working copy)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -36,6 +36,7 @@
#include <unistd.h>
#include <stdio.h>
+#include <stdarg.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>
@@ -45,7 +46,6 @@
#include "libgfortran.h"
#include "io.h"
-#include "unix.h"
#ifndef SSIZE_MAX
#define SSIZE_MAX SHRT_MAX
@@ -81,6 +81,42 @@
#define S_IWOTH 0
#endif
+
+/* Unix stream I/O module */
+
+#define BUFFER_SIZE 8192
+
+typedef struct
+{
+ stream st;
+
+ int fd;
+ gfc_offset buffer_offset; /* File offset of the start of the buffer */
+ gfc_offset physical_offset; /* Current physical file offset */
+ gfc_offset logical_offset; /* Current logical file offset */
+ gfc_offset dirty_offset; /* Start of modified bytes in buffer */
+ gfc_offset file_length; /* Length of the file, -1 if not seekable. */
+
+ char *buffer;
+ int len; /* Physical length of the current buffer */
+ int active; /* Length of valid bytes in the buffer */
+
+ int prot;
+ int ndirty; /* Dirty bytes starting at dirty_offset */
+
+ int special_file; /* =1 if the fd refers to a special file */
+
+ unsigned unbuffered:1;
+
+ char small_buffer[BUFFER_SIZE];
+
+}
+unix_stream;
+
+extern stream *init_error_stream (unix_stream *);
+internal_proto(init_error_stream);
+
+
/* This implementation of stream I/O is based on the paper:
*
* "Exploiting the advantages of mapped files for stream I/O",
@@ -1346,7 +1382,104 @@
return (stream *) error;
}
+/* st_printf()-- simple printf() function for streams that handles the
+ * formats %d, %s and %c. This function handles printing of error
+ * messages that originate within the library itself, not from a user
+ * program. */
+int
+st_printf (const char *format, ...)
+{
+ int count, total;
+ va_list arg;
+ char *p;
+ const char *q;
+ stream *s;
+ char itoa_buf[GFC_ITOA_BUF_SIZE];
+ unix_stream err_stream;
+
+ total = 0;
+ s = init_error_stream (&err_stream);
+ va_start (arg, format);
+
+ for (;;)
+ {
+ count = 0;
+
+ while (format[count] != '%' && format[count] != '\0')
+ count++;
+
+ if (count != 0)
+ {
+ p = salloc_w (s, &count);
+ memmove (p, format, count);
+ sfree (s);
+ }
+
+ total += count;
+ format += count;
+ if (*format++ == '\0')
+ break;
+
+ switch (*format)
+ {
+ case 'c':
+ count = 1;
+
+ p = salloc_w (s, &count);
+ *p = (char) va_arg (arg, int);
+
+ sfree (s);
+ break;
+
+ case 'd':
+ q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 'x':
+ q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 's':
+ q = va_arg (arg, char *);
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case '\0':
+ return total;
+
+ default:
+ count = 2;
+ p = salloc_w (s, &count);
+ p[0] = format[-1];
+ p[1] = format[0];
+ sfree (s);
+ break;
+ }
+
+ total += count;
+ format++;
+ }
+
+ va_end (arg);
+ return total;
+}
+
+
/* compare_file_filename()-- Given an open stream and a fortran string
* that is a filename, figure out if the file is the same as the
* filename. */
Index: libgfortran/io/intrinsics.c
===================================================================
--- libgfortran/io/intrinsics.c (revision 120528)
+++ libgfortran/io/intrinsics.c (working copy)
@@ -1,6 +1,6 @@
-/* Implementation of the FGET, FGETC, FPUT and FPUTC intrinsics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
+ FTELL, TTYNAM and ISATTY intrinsics.
+ Copyright (C) 2005, 2007 Free Software Foundation, Inc.
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -31,9 +31,13 @@
#include "config.h"
#include "libgfortran.h"
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
#include <string.h>
-#include "../io/io.h"
+#include "io.h"
static const int five = 5;
static const int six = 6;
@@ -175,3 +179,189 @@
FPUT_SUB(4)
FPUT_SUB(8)
+
+/* SUBROUTINE FLUSH(UNIT)
+ INTEGER, INTENT(IN), OPTIONAL :: UNIT */
+
+extern void flush_i4 (GFC_INTEGER_4 *);
+export_proto(flush_i4);
+
+void
+flush_i4 (GFC_INTEGER_4 *unit)
+{
+ gfc_unit *us;
+
+ /* flush all streams */
+ if (unit == NULL)
+ flush_all_units ();
+ else
+ {
+ us = find_unit (*unit);
+ if (us != NULL)
+ {
+ flush (us->s);
+ unlock_unit (us);
+ }
+ }
+}
+
+
+extern void flush_i8 (GFC_INTEGER_8 *);
+export_proto(flush_i8);
+
+void
+flush_i8 (GFC_INTEGER_8 *unit)
+{
+ gfc_unit *us;
+
+ /* flush all streams */
+ if (unit == NULL)
+ flush_all_units ();
+ else
+ {
+ us = find_unit (*unit);
+ if (us != NULL)
+ {
+ flush (us->s);
+ unlock_unit (us);
+ }
+ }
+}
+
+
+/* FTELL intrinsic */
+
+extern size_t PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+size_t
+PREFIX(ftell) (int * unit)
+{
+ gfc_unit * u = find_unit (*unit);
+ size_t ret;
+ if (u == NULL)
+ return ((size_t) -1);
+ ret = (size_t) stream_offset (u->s);
+ unlock_unit (u);
+ return ret;
+}
+
+#define FTELL_SUB(kind) \
+ extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
+ export_proto(ftell_i ## kind ## _sub); \
+ void \
+ ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
+ { \
+ gfc_unit * u = find_unit (*unit); \
+ if (u == NULL) \
+ *offset = -1; \
+ else \
+ { \
+ *offset = stream_offset (u->s); \
+ unlock_unit (u); \
+ } \
+ }
+
+FTELL_SUB(1)
+FTELL_SUB(2)
+FTELL_SUB(4)
+FTELL_SUB(8)
+
+
+
+/* LOGICAL FUNCTION ISATTY(UNIT)
+ INTEGER, INTENT(IN) :: UNIT */
+
+extern GFC_LOGICAL_4 isatty_l4 (int *);
+export_proto(isatty_l4);
+
+GFC_LOGICAL_4
+isatty_l4 (int *unit)
+{
+ gfc_unit *u;
+ GFC_LOGICAL_4 ret = 0;
+
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ ret = (GFC_LOGICAL_4) stream_isatty (u->s);
+ unlock_unit (u);
+ }
+ return ret;
+}
+
+
+extern GFC_LOGICAL_8 isatty_l8 (int *);
+export_proto(isatty_l8);
+
+GFC_LOGICAL_8
+isatty_l8 (int *unit)
+{
+ gfc_unit *u;
+ GFC_LOGICAL_8 ret = 0;
+
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ ret = (GFC_LOGICAL_8) stream_isatty (u->s);
+ unlock_unit (u);
+ }
+ return ret;
+}
+
+
+/* SUBROUTINE TTYNAM(UNIT,NAME)
+ INTEGER,SCALAR,INTENT(IN) :: UNIT
+ CHARACTER,SCALAR,INTENT(OUT) :: NAME */
+
+extern void ttynam_sub (int *, char *, gfc_charlen_type);
+export_proto(ttynam_sub);
+
+void
+ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
+{
+ gfc_unit *u;
+ char * n;
+ int i;
+
+ memset (name, ' ', name_len);
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ n = stream_ttyname (u->s);
+ if (n != NULL)
+ {
+ i = 0;
+ while (*n && i < name_len)
+ name[i++] = *(n++);
+ }
+ unlock_unit (u);
+ }
+}
+
+
+extern void ttynam (char **, gfc_charlen_type *, int);
+export_proto(ttynam);
+
+void
+ttynam (char ** name, gfc_charlen_type * name_len, int unit)
+{
+ gfc_unit *u;
+
+ u = find_unit (unit);
+ if (u != NULL)
+ {
+ *name = stream_ttyname (u->s);
+ if (*name != NULL)
+ {
+ *name_len = strlen (*name);
+ *name = strdup (*name);
+ unlock_unit (u);
+ return;
+ }
+ unlock_unit (u);
+ }
+
+ *name_len = 0;
+ *name = NULL;
+}
Index: libgfortran/io/unix.h
===================================================================
--- libgfortran/io/unix.h (revision 120583)
+++ libgfortran/io/unix.h (working copy)
@@ -1,63 +0,0 @@
-/* Copyright (C) 2002, 2003, 2004, 2005
- Free Software Foundation, Inc.
- Contributed by Andy Vaught
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-/* Unix stream I/O module */
-
-#define BUFFER_SIZE 8192
-
-typedef struct
-{
- stream st;
-
- int fd;
- gfc_offset buffer_offset; /* File offset of the start of the buffer */
- gfc_offset physical_offset; /* Current physical file offset */
- gfc_offset logical_offset; /* Current logical file offset */
- gfc_offset dirty_offset; /* Start of modified bytes in buffer */
- gfc_offset file_length; /* Length of the file, -1 if not seekable. */
-
- char *buffer;
- int len; /* Physical length of the current buffer */
- int active; /* Length of valid bytes in the buffer */
-
- int prot;
- int ndirty; /* Dirty bytes starting at dirty_offset */
-
- int special_file; /* =1 if the fd refers to a special file */
-
- unsigned unbuffered:1;
-
- char small_buffer[BUFFER_SIZE];
-
-}
-unix_stream;
-
-extern stream *init_error_stream (unix_stream *);
-internal_proto(init_error_stream);
Index: libgfortran/intrinsics/flush.c
===================================================================
--- libgfortran/intrinsics/flush.c (revision 120583)
+++ libgfortran/intrinsics/flush.c (working copy)
@@ -1,87 +0,0 @@
-/* Implementation of the FLUSH intrinsic.
- Copyright (C) 2004, 2005 Free Software Foundation, Inc.
- Contributed by Steven G. Kargl <kargls@comcast.net>.
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING. If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-
-#include "config.h"
-#include "libgfortran.h"
-
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-
-#include "../io/io.h"
-
-/* SUBROUTINE FLUSH(UNIT)
- INTEGER, INTENT(IN), OPTIONAL :: UNIT */
-
-extern void flush_i4 (GFC_INTEGER_4 *);
-export_proto(flush_i4);
-
-void
-flush_i4 (GFC_INTEGER_4 *unit)
-{
- gfc_unit *us;
-
- /* flush all streams */
- if (unit == NULL)
- flush_all_units ();
- else
- {
- us = find_unit (*unit);
- if (us != NULL)
- {
- flush (us->s);
- unlock_unit (us);
- }
- }
-}
-
-
-extern void flush_i8 (GFC_INTEGER_8 *);
-export_proto(flush_i8);
-
-void
-flush_i8 (GFC_INTEGER_8 *unit)
-{
- gfc_unit *us;
-
- /* flush all streams */
- if (unit == NULL)
- flush_all_units ();
- else
- {
- us = find_unit (*unit);
- if (us != NULL)
- {
- flush (us->s);
- unlock_unit (us);
- }
- }
-}
Index: libgfortran/intrinsics/fget.c
===================================================================
--- libgfortran/intrinsics/fget.c (revision 120583)
+++ libgfortran/intrinsics/fget.c (working copy)
@@ -1,177 +0,0 @@
-/* Implementation of the FGET, FGETC, FPUT and FPUTC intrinsics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING. If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-#include "config.h"
-#include "libgfortran.h"
-
-#include <string.h>
-
-#include "../io/io.h"
-
-static const int five = 5;
-static const int six = 6;
-
-extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
-export_proto_np(PREFIX(fgetc));
-
-int
-PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
-{
- int ret;
- size_t s;
- gfc_unit * u = find_unit (*unit);
-
- if (u == NULL)
- return -1;
-
- s = 1;
- memset (c, ' ', c_len);
- ret = sread (u->s, c, &s);
- unlock_unit (u);
-
- if (ret != 0)
- return ret;
-
- if (s != 1)
- return -1;
- else
- return 0;
-}
-
-
-#define FGETC_SUB(kind) \
- extern void fgetc_i ## kind ## _sub \
- (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
- export_proto(fgetc_i ## kind ## _sub); \
- void fgetc_i ## kind ## _sub \
- (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
- { if (st != NULL) \
- *st = PREFIX(fgetc) (unit, c, c_len); \
- else \
- PREFIX(fgetc) (unit, c, c_len); }
-
-FGETC_SUB(1)
-FGETC_SUB(2)
-FGETC_SUB(4)
-FGETC_SUB(8)
-
-
-extern int PREFIX(fget) (char *, gfc_charlen_type);
-export_proto_np(PREFIX(fget));
-
-int
-PREFIX(fget) (char * c, gfc_charlen_type c_len)
-{
- return PREFIX(fgetc) (&five, c, c_len);
-}
-
-
-#define FGET_SUB(kind) \
- extern void fget_i ## kind ## _sub \
- (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
- export_proto(fget_i ## kind ## _sub); \
- void fget_i ## kind ## _sub \
- (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
- { if (st != NULL) \
- *st = PREFIX(fgetc) (&five, c, c_len); \
- else \
- PREFIX(fgetc) (&five, c, c_len); }
-
-FGET_SUB(1)
-FGET_SUB(2)
-FGET_SUB(4)
-FGET_SUB(8)
-
-
-
-extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
-export_proto_np(PREFIX(fputc));
-
-int
-PREFIX(fputc) (const int * unit, char * c,
- gfc_charlen_type c_len __attribute__((unused)))
-{
- size_t s;
- int ret;
- gfc_unit * u = find_unit (*unit);
-
- if (u == NULL)
- return -1;
-
- s = 1;
- ret = swrite (u->s, c, &s);
- unlock_unit (u);
- return ret;
-}
-
-
-#define FPUTC_SUB(kind) \
- extern void fputc_i ## kind ## _sub \
- (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
- export_proto(fputc_i ## kind ## _sub); \
- void fputc_i ## kind ## _sub \
- (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
- { if (st != NULL) \
- *st = PREFIX(fputc) (unit, c, c_len); \
- else \
- PREFIX(fputc) (unit, c, c_len); }
-
-FPUTC_SUB(1)
-FPUTC_SUB(2)
-FPUTC_SUB(4)
-FPUTC_SUB(8)
-
-
-extern int PREFIX(fput) (char *, gfc_charlen_type);
-export_proto_np(PREFIX(fput));
-
-int
-PREFIX(fput) (char * c, gfc_charlen_type c_len)
-{
- return PREFIX(fputc) (&six, c, c_len);
-}
-
-
-#define FPUT_SUB(kind) \
- extern void fput_i ## kind ## _sub \
- (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
- export_proto(fput_i ## kind ## _sub); \
- void fput_i ## kind ## _sub \
- (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
- { if (st != NULL) \
- *st = PREFIX(fputc) (&six, c, c_len); \
- else \
- PREFIX(fputc) (&six, c, c_len); }
-
-FPUT_SUB(1)
-FPUT_SUB(2)
-FPUT_SUB(4)
-FPUT_SUB(8)
-
Index: libgfortran/intrinsics/ftell.c
===================================================================
--- libgfortran/intrinsics/ftell.c (revision 120583)
+++ libgfortran/intrinsics/ftell.c (working copy)
@@ -1,72 +0,0 @@
-/* Implementation of the FTELL intrinsic.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING. If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-#include "config.h"
-#include "libgfortran.h"
-
-#include <string.h>
-
-#include "../io/io.h"
-
-extern size_t PREFIX(ftell) (int *);
-export_proto_np(PREFIX(ftell));
-
-size_t
-PREFIX(ftell) (int * unit)
-{
- gfc_unit * u = find_unit (*unit);
- size_t ret;
- if (u == NULL)
- return ((size_t) -1);
- ret = (size_t) stream_offset (u->s);
- unlock_unit (u);
- return ret;
-}
-
-#define FTELL_SUB(kind) \
- extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
- export_proto(ftell_i ## kind ## _sub); \
- void \
- ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
- { \
- gfc_unit * u = find_unit (*unit); \
- if (u == NULL) \
- *offset = -1; \
- else \
- { \
- *offset = stream_offset (u->s); \
- unlock_unit (u); \
- } \
- }
-
-FTELL_SUB(1)
-FTELL_SUB(2)
-FTELL_SUB(4)
-FTELL_SUB(8)
Index: libgfortran/intrinsics/tty.c
===================================================================
--- libgfortran/intrinsics/tty.c (revision 120583)
+++ libgfortran/intrinsics/tty.c (working copy)
@@ -1,132 +0,0 @@
-/* Implementation of the ISATTY and TTYNAM g77 intrinsics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public
-License as published by the Free Software Foundation; either
-version 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING. If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-#include "config.h"
-#include "libgfortran.h"
-#include "../io/io.h"
-
-#include <string.h>
-
-/* LOGICAL FUNCTION ISATTY(UNIT)
- INTEGER, INTENT(IN) :: UNIT */
-
-extern GFC_LOGICAL_4 isatty_l4 (int *);
-export_proto(isatty_l4);
-
-GFC_LOGICAL_4
-isatty_l4 (int *unit)
-{
- gfc_unit *u;
- GFC_LOGICAL_4 ret = 0;
-
- u = find_unit (*unit);
- if (u != NULL)
- {
- ret = (GFC_LOGICAL_4) stream_isatty (u->s);
- unlock_unit (u);
- }
- return ret;
-}
-
-
-extern GFC_LOGICAL_8 isatty_l8 (int *);
-export_proto(isatty_l8);
-
-GFC_LOGICAL_8
-isatty_l8 (int *unit)
-{
- gfc_unit *u;
- GFC_LOGICAL_8 ret = 0;
-
- u = find_unit (*unit);
- if (u != NULL)
- {
- ret = (GFC_LOGICAL_8) stream_isatty (u->s);
- unlock_unit (u);
- }
- return ret;
-}
-
-
-/* SUBROUTINE TTYNAM(UNIT,NAME)
- INTEGER,SCALAR,INTENT(IN) :: UNIT
- CHARACTER,SCALAR,INTENT(OUT) :: NAME */
-
-extern void ttynam_sub (int *, char *, gfc_charlen_type);
-export_proto(ttynam_sub);
-
-void
-ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
-{
- gfc_unit *u;
- char * n;
- int i;
-
- memset (name, ' ', name_len);
- u = find_unit (*unit);
- if (u != NULL)
- {
- n = stream_ttyname (u->s);
- if (n != NULL)
- {
- i = 0;
- while (*n && i < name_len)
- name[i++] = *(n++);
- }
- unlock_unit (u);
- }
-}
-
-
-extern void ttynam (char **, gfc_charlen_type *, int);
-export_proto(ttynam);
-
-void
-ttynam (char ** name, gfc_charlen_type * name_len, int unit)
-{
- gfc_unit *u;
-
- u = find_unit (unit);
- if (u != NULL)
- {
- *name = stream_ttyname (u->s);
- if (*name != NULL)
- {
- *name_len = strlen (*name);
- *name = strdup (*name);
- unlock_unit (u);
- return;
- }
- unlock_unit (u);
- }
-
- *name_len = 0;
- *name = NULL;
-}
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |