#define CACHE_SIZE 3
-static gfc_unit internal_unit, *unit_cache[CACHE_SIZE];
+static gfc_unit *unit_cache[CACHE_SIZE];
gfc_offset max_offset;
gfc_unit *unit_root;
#ifdef __GTHREAD_MUTEX_INIT
}
-/* find_unit()-- Given an integer, return a pointer to the unit
+/* get_external_unit()-- Given an integer, return a pointer to the unit
* structure. Returns NULL if the unit does not exist,
* otherwise returns a locked unit. */
static gfc_unit *
-find_unit_1 (int n, int do_create)
+get_external_unit (int n, int do_create)
{
gfc_unit *p;
int c, created = 0;
return p;
}
+
gfc_unit *
find_unit (int n)
{
- return find_unit_1 (n, 0);
+ return get_external_unit (n, 0);
}
+
gfc_unit *
find_or_create_unit (int n)
{
- return find_unit_1 (n, 1);
+ return get_external_unit (n, 1);
}
-/* get_unit()-- Returns the unit structure associated with the integer
- * unit or the internal file. */
gfc_unit *
-get_unit (st_parameter_dt *dtp, int do_create)
+get_internal_unit (st_parameter_dt *dtp)
{
- if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
- {
- __gthread_mutex_lock (&internal_unit.lock);
- internal_unit.recl = dtp->internal_unit_len;
- if (is_array_io (dtp))
- {
- internal_unit.rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc);
- internal_unit.ls = (array_loop_spec *)
- get_mem (internal_unit.rank * sizeof (array_loop_spec));
- dtp->internal_unit_len *=
- init_loop_spec (dtp->internal_unit_desc, internal_unit.ls);
- }
+ gfc_unit * iunit;
- internal_unit.s =
- open_internal (dtp->internal_unit, dtp->internal_unit_len);
- internal_unit.bytes_left = internal_unit.recl;
- internal_unit.last_record=0;
- internal_unit.maxrec=0;
- internal_unit.current_record=0;
+ /* Allocate memory for a unit structure. */
- if (dtp->u.p.mode==WRITING && !is_array_io (dtp))
- empty_internal_buffer (internal_unit.s);
+ iunit = get_mem (sizeof (gfc_unit));
+ if (iunit == NULL)
+ {
+ generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
+ return NULL;
+ }
- /* Set flags for the internal unit */
+ memset (iunit, '\0', sizeof (gfc_unit));
+#ifdef __GTHREAD_MUTEX_INIT
+ {
+ __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
+ iunit->lock = tmp;
+ }
+#else
+ __GTHREAD_MUTEX_INIT_FUNCTION (&iunit->lock);
+#endif
+ __gthread_mutex_lock (&iunit->lock);
- internal_unit.flags.access = ACCESS_SEQUENTIAL;
- internal_unit.flags.action = ACTION_READWRITE;
- internal_unit.flags.form = FORM_FORMATTED;
- internal_unit.flags.delim = DELIM_NONE;
- internal_unit.flags.pad = PAD_YES;
+ iunit->recl = dtp->internal_unit_len;
+
+ /* For internal units we set the unit number to -1.
+ Otherwise internal units can be mistaken for a pre-connected unit or
+ some other file I/O unit. */
+ iunit->unit_number = -1;
- return &internal_unit;
+ /* Set up the looping specification from the array descriptor, if any. */
+
+ if (is_array_io (dtp))
+ {
+ iunit->rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc);
+ iunit->ls = (array_loop_spec *)
+ get_mem (iunit->rank * sizeof (array_loop_spec));
+ dtp->internal_unit_len *=
+ init_loop_spec (dtp->internal_unit_desc, iunit->ls);
}
- /* Has to be an external unit */
+ /* Set initial values for unit parameters. */
- return find_unit_1 (dtp->common.unit, do_create);
-}
+ iunit->s = open_internal (dtp->internal_unit, dtp->internal_unit_len);
+ iunit->bytes_left = iunit->recl;
+ iunit->last_record=0;
+ iunit->maxrec=0;
+ iunit->current_record=0;
+ iunit->read_bad = 0;
+ /* Set flags for the internal unit. */
-/* is_internal_unit()-- Determine if the current unit is internal or not */
+ iunit->flags.access = ACCESS_SEQUENTIAL;
+ iunit->flags.action = ACTION_READWRITE;
+ iunit->flags.form = FORM_FORMATTED;
+ iunit->flags.pad = PAD_YES;
+ iunit->flags.status = STATUS_UNSPECIFIED;
+ iunit->endfile = NO_ENDFILE;
-int
-is_internal_unit (st_parameter_dt *dtp)
+ /* Initialize the data transfer parameters. */
+
+ dtp->u.p.advance_status = ADVANCE_YES;
+ dtp->u.p.blank_status = BLANK_UNSPECIFIED;
+ dtp->u.p.seen_dollar = 0;
+ dtp->u.p.skips = 0;
+ dtp->u.p.pending_spaces = 0;
+ dtp->u.p.max_pos = 0;
+ dtp->u.p.at_eof = 0;
+
+ /* This flag tells us the unit is assigned to internal I/O. */
+
+ dtp->u.p.unit_is_internal = 1;
+
+ return iunit;
+}
+
+
+/* free_internal_unit()-- Free memory allocated for internal units if any. */
+void
+free_internal_unit (st_parameter_dt *dtp)
{
- return dtp->u.p.current_unit == &internal_unit;
+ if (!is_internal_unit (dtp))
+ return;
+
+ if (dtp->u.p.current_unit->ls != NULL)
+ free_mem (dtp->u.p.current_unit->ls);
+
+ sclose (dtp->u.p.current_unit->s);
+
+ if (dtp->u.p.current_unit != NULL)
+ free_mem (dtp->u.p.current_unit);
}
-/* is_array_io ()-- Determine if the I/O is to/from an array */
+/* get_unit()-- Returns the unit structure associated with the integer
+ * unit or the internal file. */
-int
-is_array_io (st_parameter_dt *dtp)
+gfc_unit *
+get_unit (st_parameter_dt *dtp, int do_create)
{
- return dtp->internal_unit_desc != NULL;
+
+ if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
+ return get_internal_unit(dtp);
+
+ /* Has to be an external unit */
+
+ dtp->u.p.unit_is_internal = 0;
+ dtp->internal_unit_desc = NULL;
+
+ return get_external_unit (dtp->common.unit, do_create);
}
__GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
#endif
-#ifdef __GTHREAD_MUTEX_INIT
- {
- __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
- internal_unit.lock = tmp;
- }
-#else
- __GTHREAD_MUTEX_INIT_FUNCTION (&internal_unit.lock);
-#endif
-
if (options.stdin_unit >= 0)
{ /* STDIN */
u = insert_unit (options.stdin_unit);
{
int i, rc;
+ /* If there are previously written bytes from a write with ADVANCE="no"
+ Reposition the buffer before closing. */
+ if (u->saved_pos > 0)
+ {
+ char *p;
+
+ p = salloc_w (u->s, &u->saved_pos);
+
+ if (!(u->unit_number == options.stdout_unit
+ || u->unit_number == options.stderr_unit))
+ {
+ size_t len;
+
+ const char crlf[] = "\r\n";
+#ifdef HAVE_CRLF
+ len = 2;
+#else
+ len = 1;
+#endif
+ if (swrite (u->s, &crlf[2-len], &len) != 0)
+ os_error ("Close after ADVANCE_NO failed");
+ }
+ }
+
rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
u->closed = 1;
close_unit_1 (unit_root, 1);
__gthread_mutex_unlock (&unit_lock);
}
+
+
+/* update_position()-- Update the flags position for later use by inquire. */
+
+void
+update_position (gfc_unit *u)
+{
+ if (file_position (u->s) == 0)
+ u->flags.position = POSITION_REWIND;
+ else if (file_length (u->s) == file_position (u->s))
+ u->flags.position = POSITION_APPEND;
+ else
+ u->flags.position = POSITION_ASIS;
+}
OSDN Git Service
