libgfortran/io/unit.c

   1 /* Copyright (C) 2002, 2003 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 Libgfortran is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with Libgfortran; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include "config.h"
  22 #include <stdlib.h>
  23 #include <string.h>
  24 #include "libgfortran.h"
  25 #include "io.h"
  26
  27
  28 /* Subroutines related to units */
  29
  30
  31 #define CACHE_SIZE 3
  32 static gfc_unit internal_unit, *unit_cache[CACHE_SIZE];
  33
  34
  35 /* This implementation is based on Stefan Nilsson's article in the
  36  * July 1997 Doctor Dobb's Journal, "Treaps in Java". */
  37
  38 /* pseudo_random()-- Simple linear congruential pseudorandom number
  39  * generator.  The period of this generator is 44071, which is plenty
  40  * for our purposes.  */
  41
  42 static int
  43 pseudo_random (void)
  44 {
  45   static int x0 = 5341;
  46
  47   x0 = (22611 * x0 + 10) % 44071;
  48   return x0;
  49 }
  50
  51
  52 /* rotate_left()-- Rotate the treap left */
  53
  54 static gfc_unit *
  55 rotate_left (gfc_unit * t)
  56 {
  57   gfc_unit *temp;
  58
  59   temp = t->right;
  60   t->right = t->right->left;
  61   temp->left = t;
  62
  63   return temp;
  64 }
  65
  66
  67 /* rotate_right()-- Rotate the treap right */
  68
  69 static gfc_unit *
  70 rotate_right (gfc_unit * t)
  71 {
  72   gfc_unit *temp;
  73
  74   temp = t->left;
  75   t->left = t->left->right;
  76   temp->right = t;
  77
  78   return temp;
  79 }
  80
  81
  82
  83 static int
  84 compare (int a, int b)
  85 {
  86   if (a < b)
  87     return -1;
  88   if (a > b)
  89     return 1;
  90
  91   return 0;
  92 }
  93
  94
  95 /* insert()-- Recursive insertion function.  Returns the updated treap. */
  96
  97 static gfc_unit *
  98 insert (gfc_unit * new, gfc_unit * t)
  99 {
 100   int c;
 101
 102   if (t == NULL)
 103     return new;
 104
 105   c = compare (new->unit_number, t->unit_number);
 106
 107   if (c < 0)
 108     {
 109       t->left = insert (new, t->left);
 110       if (t->priority < t->left->priority)
 111         t = rotate_right (t);
 112     }
 113
 114   if (c > 0)
 115     {
 116       t->right = insert (new, t->right);
 117       if (t->priority < t->right->priority)
 118         t = rotate_left (t);
 119     }
 120
 121   if (c == 0)
 122     internal_error ("insert(): Duplicate key found!");
 123
 124   return t;
 125 }
 126
 127
 128 /* insert_unit()-- Given a new node, insert it into the treap.  It is
 129  * an error to insert a key that already exists. */
 130
 131 void
 132 insert_unit (gfc_unit * new)
 133 {
 134   new->priority = pseudo_random ();
 135   g.unit_root = insert (new, g.unit_root);
 136 }
 137
 138
 139 static gfc_unit *
 140 delete_root (gfc_unit * t)
 141 {
 142   gfc_unit *temp;
 143
 144   if (t->left == NULL)
 145     return t->right;
 146   if (t->right == NULL)
 147     return t->left;
 148
 149   if (t->left->priority > t->right->priority)
 150     {
 151       temp = rotate_right (t);
 152       temp->right = delete_root (t);
 153     }
 154   else
 155     {
 156       temp = rotate_left (t);
 157       temp->left = delete_root (t);
 158     }
 159
 160   return temp;
 161 }
 162
 163
 164 /* delete_treap()-- Delete an element from a tree.  The 'old' value
 165  * does not necessarily have to point to the element to be deleted, it
 166  * must just point to a treap structure with the key to be deleted.
 167  * Returns the new root node of the tree. */
 168
 169 static gfc_unit *
 170 delete_treap (gfc_unit * old, gfc_unit * t)
 171 {
 172   int c;
 173
 174   if (t == NULL)
 175     return NULL;
 176
 177   c = compare (old->unit_number, t->unit_number);
 178
 179   if (c < 0)
 180     t->left = delete_treap (old, t->left);
 181   if (c > 0)
 182     t->right = delete_treap (old, t->right);
 183   if (c == 0)
 184     t = delete_root (t);
 185
 186   return t;
 187 }
 188
 189
 190 /* delete_unit()-- Delete a unit from a tree */
 191
 192 static void
 193 delete_unit (gfc_unit * old)
 194 {
 195   g.unit_root = delete_treap (old, g.unit_root);
 196 }
 197
 198
 199 /* find_unit()-- Given an integer, return a pointer to the unit
 200  * structure.  Returns NULL if the unit does not exist. */
 201
 202 gfc_unit *
 203 find_unit (int n)
 204 {
 205   gfc_unit *p;
 206   int c;
 207
 208   for (c = 0; c < CACHE_SIZE; c++)
 209     if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n)
 210       {
 211         p = unit_cache[c];
 212         return p;
 213       }
 214
 215   p = g.unit_root;
 216   while (p != NULL)
 217     {
 218       c = compare (n, p->unit_number);
 219       if (c < 0)
 220         p = p->left;
 221       if (c > 0)
 222         p = p->right;
 223       if (c == 0)
 224         break;
 225     }
 226
 227   if (p != NULL)
 228     {
 229       for (c = 0; c < CACHE_SIZE - 1; c++)
 230         unit_cache[c] = unit_cache[c + 1];
 231
 232       unit_cache[CACHE_SIZE - 1] = p;
 233     }
 234
 235   return p;
 236 }
 237
 238 /* get_unit()-- Returns the unit structure associated with the integer
 239  * unit or the internal file. */
 240
 241 gfc_unit *
 242 get_unit (int read_flag)
 243 {
 244   if (ioparm.internal_unit != NULL)
 245     {
 246       internal_unit.s =
 247         open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
 248
 249       /* Set flags for the internal unit */
 250
 251       internal_unit.flags.access = ACCESS_SEQUENTIAL;
 252       internal_unit.flags.action = ACTION_READWRITE;
 253       internal_unit.flags.form = FORM_FORMATTED;
 254       internal_unit.flags.delim = DELIM_NONE;
 255
 256       return &internal_unit;
 257     }
 258
 259   /* Has to be an external unit */
 260
 261   return find_unit (ioparm.unit);
 262 }
 263
 264
 265 /* is_internal_unit()-- Determine if the current unit is internal or
 266  * not */
 267
 268 int
 269 is_internal_unit ()
 270 {
 271   return current_unit == &internal_unit;
 272 }
 273
 274
 275
 276 /*************************/
 277 /* Initialize everything */
 278
 279 void
 280 init_units (void)
 281 {
 282   gfc_offset m, n;
 283   gfc_unit *u;
 284   int i;
 285
 286   if (options.stdin_unit >= 0)
 287     {                           /* STDIN */
 288       u = get_mem (sizeof (gfc_unit));
 289
 290       u->unit_number = options.stdin_unit;
 291       u->s = input_stream ();
 292
 293       u->flags.action = ACTION_READ;
 294
 295       u->flags.access = ACCESS_SEQUENTIAL;
 296       u->flags.form = FORM_FORMATTED;
 297       u->flags.status = STATUS_OLD;
 298       u->flags.blank = BLANK_ZERO;
 299       u->flags.position = POSITION_ASIS;
 300
 301       u->recl = options.default_recl;
 302       u->endfile = NO_ENDFILE;
 303
 304       insert_unit (u);
 305     }
 306
 307   if (options.stdout_unit >= 0)
 308     {                           /* STDOUT */
 309       u = get_mem (sizeof (gfc_unit));
 310
 311       u->unit_number = options.stdout_unit;
 312       u->s = output_stream ();
 313
 314       u->flags.action = ACTION_WRITE;
 315
 316       u->flags.access = ACCESS_SEQUENTIAL;
 317       u->flags.form = FORM_FORMATTED;
 318       u->flags.status = STATUS_OLD;
 319       u->flags.blank = BLANK_ZERO;
 320       u->flags.position = POSITION_ASIS;
 321
 322       u->recl = options.default_recl;
 323       u->endfile = AT_ENDFILE;
 324
 325       insert_unit (u);
 326     }
 327
 328   /* Calculate the maximum file offset in a portable manner.
 329    * max will be the largest signed number for the type gfc_offset.
 330    *
 331    * set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
 332
 333   g.max_offset = 0;
 334   for (i=0; i < sizeof(g.max_offset) * 8 - 1; i++)
 335     g.max_offset = g.max_offset + ((gfc_offset) 1 << i);
 336
 337 }
 338
 339
 340 /* close_unit()-- Close a unit.  The stream is closed, and any memory
 341  * associated with the stream is freed.  Returns nonzero on I/O error. */
 342
 343 int
 344 close_unit (gfc_unit * u)
 345 {
 346   int i, rc;
 347
 348   for (i = 0; i < CACHE_SIZE; i++)
 349     if (unit_cache[i] == u)
 350       unit_cache[i] = NULL;
 351
 352   rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
 353
 354   delete_unit (u);
 355   free_mem (u);
 356
 357   return rc;
 358 }
 359
 360
 361 /* close_units()-- Delete units on completion.  We just keep deleting
 362  * the root of the treap until there is nothing left. */
 363
 364 void
 365 close_units (void)
 366 {
 367   while (g.unit_root != NULL)
 368     close_unit (g.unit_root);
 369 }