gcc/libgfortran/io/unit.c
Tobias Schlüter 81f4be3ce1 re PR libfortran/15235 (libgfortran doesn't build on Solaris 10)
PR fortran/15235
* gfortran.h (offset_t): Rename to ...
(gfc_offset): ... this.
* io/backspace.c (formatted_backspace, unformatted_backspace),
io/io.h (stream, gfc_unit, global_t, file_length, file_position),
transfer.c (us_read, us_write, next_record_r, next_record_w),
io/unit.c (init_units), unix.c (unix_stream, fd_alloc,
fd_alloc_r_at, fd_alloc_w_at, fd_seek, mmap_alloc,
mmap_alloc_r_at, mmap_alloc_w_at, mmap_seek, mem_alloc_r_at,
mem_alloc_w_at, mem_seek, file_length, file_position): Replace all
occurences of offset_t by gfc_offset.

From-SVN: r81994
2004-05-18 18:06:09 +02:00

381 lines
7.3 KiB
C

/* Copyright (C) 2002-2003 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.
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, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <stdlib.h>
#include <string.h>
#include "libgfortran.h"
#include "io.h"
/* Subroutines related to units */
#define CACHE_SIZE 3
static gfc_unit internal_unit, *unit_cache[CACHE_SIZE];
/* This implementation is based on Stefan Nilsson's article in the
* July 1997 Doctor Dobb's Journal, "Treaps in Java". */
/* pseudo_random()-- Simple linear congruential pseudorandom number
* generator. The period of this generator is 44071, which is plenty
* for our purposes. */
static int
pseudo_random (void)
{
static int x0 = 5341;
x0 = (22611 * x0 + 10) % 44071;
return x0;
}
/* rotate_left()-- Rotate the treap left */
static gfc_unit *
rotate_left (gfc_unit * t)
{
gfc_unit *temp;
temp = t->right;
t->right = t->right->left;
temp->left = t;
return temp;
}
/* rotate_right()-- Rotate the treap right */
static gfc_unit *
rotate_right (gfc_unit * t)
{
gfc_unit *temp;
temp = t->left;
t->left = t->left->right;
temp->right = t;
return temp;
}
static int
compare (int a, int b)
{
if (a < b)
return -1;
if (a > b)
return 1;
return 0;
}
/* insert()-- Recursive insertion function. Returns the updated treap. */
static gfc_unit *
insert (gfc_unit * new, gfc_unit * t)
{
int c;
if (t == NULL)
return new;
c = compare (new->unit_number, t->unit_number);
if (c < 0)
{
t->left = insert (new, t->left);
if (t->priority < t->left->priority)
t = rotate_right (t);
}
if (c > 0)
{
t->right = insert (new, t->right);
if (t->priority < t->right->priority)
t = rotate_left (t);
}
if (c == 0)
internal_error ("insert(): Duplicate key found!");
return t;
}
/* insert_unit()-- Given a new node, insert it into the treap. It is
* an error to insert a key that already exists. */
void
insert_unit (gfc_unit * new)
{
new->priority = pseudo_random ();
g.unit_root = insert (new, g.unit_root);
}
static gfc_unit *
delete_root (gfc_unit * t)
{
gfc_unit *temp;
if (t->left == NULL)
return t->right;
if (t->right == NULL)
return t->left;
if (t->left->priority > t->right->priority)
{
temp = rotate_right (t);
temp->right = delete_root (t);
}
else
{
temp = rotate_left (t);
temp->left = delete_root (t);
}
return temp;
}
/* delete_treap()-- Delete an element from a tree. The 'old' value
* does not necessarily have to point to the element to be deleted, it
* must just point to a treap structure with the key to be deleted.
* Returns the new root node of the tree. */
static gfc_unit *
delete_treap (gfc_unit * old, gfc_unit * t)
{
int c;
if (t == NULL)
return NULL;
c = compare (old->unit_number, t->unit_number);
if (c < 0)
t->left = delete_treap (old, t->left);
if (c > 0)
t->right = delete_treap (old, t->right);
if (c == 0)
t = delete_root (t);
return t;
}
/* delete_unit()-- Delete a unit from a tree */
static void
delete_unit (gfc_unit * old)
{
g.unit_root = delete_treap (old, g.unit_root);
}
/* find_unit()-- Given an integer, return a pointer to the unit
* structure. Returns NULL if the unit does not exist. */
gfc_unit *
find_unit (int n)
{
gfc_unit *p;
int c;
for (c = 0; c < CACHE_SIZE; c++)
if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n)
{
p = unit_cache[c];
return p;
}
p = g.unit_root;
while (p != NULL)
{
c = compare (n, p->unit_number);
if (c < 0)
p = p->left;
if (c > 0)
p = p->right;
if (c == 0)
break;
}
if (p != NULL)
{
for (c = 0; c < CACHE_SIZE - 1; c++)
unit_cache[c] = unit_cache[c + 1];
unit_cache[CACHE_SIZE - 1] = p;
}
return p;
}
/* get_unit()-- Returns the unit structure associated with the integer
* unit or the internal file. */
gfc_unit *
get_unit (int read_flag)
{
gfc_unit *u;
if (ioparm.internal_unit != NULL)
{
internal_unit.s =
open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
/* Set flags for the internal unit */
internal_unit.flags.access = ACCESS_SEQUENTIAL;
internal_unit.flags.action = ACTION_READWRITE;
internal_unit.flags.form = FORM_FORMATTED;
internal_unit.flags.delim = DELIM_NONE;
return &internal_unit;
}
/* Has to be an external unit */
u = find_unit (ioparm.unit);
if (u != NULL)
return u;
return NULL;
}
/* is_internal_unit()-- Determine if the current unit is internal or
* not */
int
is_internal_unit ()
{
return current_unit == &internal_unit;
}
/*************************/
/* Initialize everything */
void
init_units (void)
{
gfc_offset m, n;
gfc_unit *u;
int i;
if (options.stdin_unit >= 0)
{ /* STDIN */
u = get_mem (sizeof (gfc_unit));
u->unit_number = options.stdin_unit;
u->s = input_stream ();
u->flags.action = ACTION_READ;
u->flags.access = ACCESS_SEQUENTIAL;
u->flags.form = FORM_FORMATTED;
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_ZERO;
u->flags.position = POSITION_ASIS;
u->recl = options.default_recl;
u->endfile = NO_ENDFILE;
insert_unit (u);
}
if (options.stdout_unit >= 0)
{ /* STDOUT */
u = get_mem (sizeof (gfc_unit));
u->unit_number = options.stdout_unit;
u->s = output_stream ();
u->flags.action = ACTION_WRITE;
u->flags.access = ACCESS_SEQUENTIAL;
u->flags.form = FORM_FORMATTED;
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_ZERO;
u->flags.position = POSITION_ASIS;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
insert_unit (u);
}
/* Calculate the maximum file offset in a portable manner.
* max will be the largest signed number for the type gfc_offset.
*
* set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
g.max_offset = 0;
for (i=0; i < sizeof(g.max_offset) * 8 - 1; i++)
g.max_offset = g.max_offset + ((gfc_offset) 1 << i);
}
/* close_unit()-- Close a unit. The stream is closed, and any memory
* associated with the stream is freed. Returns nonzero on I/O error. */
int
close_unit (gfc_unit * u)
{
int i, rc;
for (i = 0; i < CACHE_SIZE; i++)
if (unit_cache[i] == u)
unit_cache[i] = NULL;
rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
delete_unit (u);
free_mem (u);
return rc;
}
/* close_units()-- Delete units on completion. We just keep deleting
* the root of the treap until there is nothing left. */
void
close_units (void)
{
while (g.unit_root != NULL)
close_unit (g.unit_root);
}