OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [io/] [inquire.c] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn 
/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010, 2011
2 
   Free Software Foundation, Inc.
3 
   Contributed by Andy Vaught
4 
 
5 
This file is part of the GNU Fortran runtime library (libgfortran).
6 
 
7 
Libgfortran is free software; you can redistribute it and/or modify
8 
it under the terms of the GNU General Public License as published by
9 
the Free Software Foundation; either version 3, or (at your option)
10 
any later version.
11 
 
12 
Libgfortran is distributed in the hope that it will be useful,
13 
but WITHOUT ANY WARRANTY; without even the implied warranty of
14 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 
GNU General Public License for more details.
16 
 
17 
Under Section 7 of GPL version 3, you are granted additional
18 
permissions described in the GCC Runtime Library Exception, version
19 
3.1, as published by the Free Software Foundation.
20 
 
21 
You should have received a copy of the GNU General Public License and
22 
a copy of the GCC Runtime Library Exception along with this program;
23 
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
24 
<http://www.gnu.org/licenses/>.  */
25 
 
26 
 
27 
/* Implement the non-IOLENGTH variant of the INQUIRY statement */
28 
 
29 
#include "io.h"
30 
#include "unix.h"
31 
#include <string.h>
32 
 
33 
 
34 
static const char undefined[] = "UNDEFINED";
35 
 
36 
 
37 
/* inquire_via_unit()-- Inquiry via unit number.  The unit might not exist. */
38 
 
39 
static void
40 
inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
41 
{
42 
  const char *p;
43 
  GFC_INTEGER_4 cf = iqp->common.flags;
44 
 
45 
  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
46 
    {
47 
      *iqp->exist = (iqp->common.unit >= 0
48 
                     && iqp->common.unit <= GFC_INTEGER_4_HUGE);
49 
 
50 
      if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
51 
        {
52 
          if (!(*iqp->exist))
53 
            *iqp->common.iostat = LIBERROR_BAD_UNIT;
54 
          *iqp->exist = *iqp->exist
55 
                        && (*iqp->common.iostat != LIBERROR_BAD_UNIT);
56 
        }
57 
    }
58 
 
59 
  if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
60 
    *iqp->opened = (u != NULL);
61 
 
62 
  if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
63 
    *iqp->number = (u != NULL) ? u->unit_number : -1;
64 
 
65 
  if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
66 
    *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
67 
 
68 
  if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
69 
      && u != NULL && u->flags.status != STATUS_SCRATCH)
70 
    {
71 
#if defined(HAVE_TTYNAME_R) || defined(HAVE_TTYNAME)
72 
      if (u->unit_number == options.stdin_unit
73 
          || u->unit_number == options.stdout_unit
74 
          || u->unit_number == options.stderr_unit)
75 
        {
76 
          int err = stream_ttyname (u->s, iqp->name, iqp->name_len);
77 
          if (err == 0)
78 
            {
79 
              gfc_charlen_type tmplen = strlen (iqp->name);
80 
              if (iqp->name_len > tmplen)
81 
                memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen);
82 
            }
83 
          else /* If ttyname does not work, go with the default.  */
84 
            fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
85 
        }
86 
      else
87 
        fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
88 
#elif defined __MINGW32__
89 
      if (u->unit_number == options.stdin_unit)
90 
        fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$"));
91 
      else if (u->unit_number == options.stdout_unit)
92 
        fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$"));
93 
      else if (u->unit_number == options.stderr_unit)
94 
        fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$"));
95 
      else
96 
        fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
97 
#else
98 
    fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
99 
#endif
100 
    }
101 
 
102 
  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
103 
    {
104 
      if (u == NULL)
105 
        p = undefined;
106 
      else
107 
        switch (u->flags.access)
108 
          {
109 
          case ACCESS_SEQUENTIAL:
110 
            p = "SEQUENTIAL";
111 
            break;
112 
          case ACCESS_DIRECT:
113 
            p = "DIRECT";
114 
            break;
115 
          case ACCESS_STREAM:
116 
            p = "STREAM";
117 
            break;
118 
          default:
119 
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
120 
          }
121 
 
122 
      cf_strcpy (iqp->access, iqp->access_len, p);
123 
    }
124 
 
125 
  if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
126 
    {
127 
      if (u == NULL)
128 
        p = inquire_sequential (NULL, 0);
129 
      else
130 
        switch (u->flags.access)
131 
          {
132 
          case ACCESS_DIRECT:
133 
          case ACCESS_STREAM:
134 
            p = "NO";
135 
            break;
136 
          case ACCESS_SEQUENTIAL:
137 
            p = "YES";
138 
            break;
139 
          default:
140 
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
141 
          }
142 
 
143 
      cf_strcpy (iqp->sequential, iqp->sequential_len, p);
144 
    }
145 
 
146 
  if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
147 
    {
148 
      if (u == NULL)
149 
        p = inquire_direct (NULL, 0);
150 
      else
151 
        switch (u->flags.access)
152 
          {
153 
          case ACCESS_SEQUENTIAL:
154 
          case ACCESS_STREAM:
155 
            p = "NO";
156 
            break;
157 
          case ACCESS_DIRECT:
158 
            p = "YES";
159 
            break;
160 
          default:
161 
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
162 
          }
163 
 
164 
      cf_strcpy (iqp->direct, iqp->direct_len, p);
165 
    }
166 
 
167 
  if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
168 
    {
169 
      if (u == NULL)
170 
        p = undefined;
171 
      else
172 
        switch (u->flags.form)
173 
          {
174 
          case FORM_FORMATTED:
175 
            p = "FORMATTED";
176 
            break;
177 
          case FORM_UNFORMATTED:
178 
            p = "UNFORMATTED";
179 
            break;
180 
          default:
181 
            internal_error (&iqp->common, "inquire_via_unit(): Bad form");
182 
          }
183 
 
184 
      cf_strcpy (iqp->form, iqp->form_len, p);
185 
    }
186 
 
187 
  if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
188 
    {
189 
      if (u == NULL)
190 
        p = inquire_formatted (NULL, 0);
191 
      else
192 
        switch (u->flags.form)
193 
          {
194 
          case FORM_FORMATTED:
195 
            p = "YES";
196 
            break;
197 
          case FORM_UNFORMATTED:
198 
            p = "NO";
199 
            break;
200 
          default:
201 
            internal_error (&iqp->common, "inquire_via_unit(): Bad form");
202 
          }
203 
 
204 
      cf_strcpy (iqp->formatted, iqp->formatted_len, p);
205 
    }
206 
 
207 
  if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
208 
    {
209 
      if (u == NULL)
210 
        p = inquire_unformatted (NULL, 0);
211 
      else
212 
        switch (u->flags.form)
213 
          {
214 
          case FORM_FORMATTED:
215 
            p = "NO";
216 
            break;
217 
          case FORM_UNFORMATTED:
218 
            p = "YES";
219 
            break;
220 
          default:
221 
            internal_error (&iqp->common, "inquire_via_unit(): Bad form");
222 
          }
223 
 
224 
      cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
225 
    }
226 
 
227 
  if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
228 
    *iqp->recl_out = (u != NULL) ? u->recl : 0;
229 
 
230 
  if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
231 
    *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
232 
 
233 
  if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
234 
    {
235 
      /* This only makes sense in the context of DIRECT access.  */
236 
      if (u != NULL && u->flags.access == ACCESS_DIRECT)
237 
        *iqp->nextrec = u->last_record + 1;
238 
      else
239 
        *iqp->nextrec = 0;
240 
    }
241 
 
242 
  if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
243 
    {
244 
      if (u == NULL || u->flags.form != FORM_FORMATTED)
245 
        p = undefined;
246 
      else
247 
        switch (u->flags.blank)
248 
          {
249 
          case BLANK_NULL:
250 
            p = "NULL";
251 
            break;
252 
          case BLANK_ZERO:
253 
            p = "ZERO";
254 
            break;
255 
          default:
256 
            internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
257 
          }
258 
 
259 
      cf_strcpy (iqp->blank, iqp->blank_len, p);
260 
    }
261 
 
262 
  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
263 
    {
264 
      if (u == NULL || u->flags.form != FORM_FORMATTED)
265 
        p = undefined;
266 
      else
267 
        switch (u->flags.pad)
268 
          {
269 
          case PAD_YES:
270 
            p = "YES";
271 
            break;
272 
          case PAD_NO:
273 
            p = "NO";
274 
            break;
275 
          default:
276 
            internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
277 
          }
278 
 
279 
      cf_strcpy (iqp->pad, iqp->pad_len, p);
280 
    }
281 
 
282 
  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
283 
    {
284 
      GFC_INTEGER_4 cf2 = iqp->flags2;
285 
 
286 
      if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
287 
        *iqp->pending = 0;
288 
 
289 
      if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
290 
        *iqp->id = 0;
291 
 
292 
      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
293 
        {
294 
          if (u == NULL || u->flags.form != FORM_FORMATTED)
295 
            p = undefined;
296 
          else
297 
            switch (u->flags.encoding)
298 
              {
299 
              case ENCODING_DEFAULT:
300 
                p = "UNKNOWN";
301 
                break;
302 
              case ENCODING_UTF8:
303 
                p = "UTF-8";
304 
                break;
305 
              default:
306 
                internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
307 
              }
308 
 
309 
          cf_strcpy (iqp->encoding, iqp->encoding_len, p);
310 
        }
311 
 
312 
      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
313 
        {
314 
          if (u == NULL || u->flags.form != FORM_FORMATTED)
315 
            p = undefined;
316 
          else
317 
            switch (u->flags.decimal)
318 
              {
319 
              case DECIMAL_POINT:
320 
                p = "POINT";
321 
                break;
322 
              case DECIMAL_COMMA:
323 
                p = "COMMA";
324 
                break;
325 
              default:
326 
                internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
327 
              }
328 
 
329 
          cf_strcpy (iqp->decimal, iqp->decimal_len, p);
330 
        }
331 
 
332 
      if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
333 
        {
334 
          if (u == NULL)
335 
            p = undefined;
336 
          else
337 
            switch (u->flags.async)
338 
            {
339 
              case ASYNC_YES:
340 
                p = "YES";
341 
                break;
342 
              case ASYNC_NO:
343 
                p = "NO";
344 
                break;
345 
              default:
346 
                internal_error (&iqp->common, "inquire_via_unit(): Bad async");
347 
            }
348 
 
349 
          cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
350 
        }
351 
 
352 
      if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
353 
        {
354 
          if (u == NULL)
355 
            p = undefined;
356 
          else
357 
            switch (u->flags.sign)
358 
            {
359 
              case SIGN_PROCDEFINED:
360 
                p = "PROCESSOR_DEFINED";
361 
                break;
362 
              case SIGN_SUPPRESS:
363 
                p = "SUPPRESS";
364 
                break;
365 
              case SIGN_PLUS:
366 
                p = "PLUS";
367 
                break;
368 
              default:
369 
                internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
370 
            }
371 
 
372 
          cf_strcpy (iqp->sign, iqp->sign_len, p);
373 
        }
374 
 
375 
      if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
376 
        {
377 
          if (u == NULL)
378 
            p = undefined;
379 
          else
380 
            switch (u->flags.round)
381 
            {
382 
              case ROUND_UP:
383 
                p = "UP";
384 
                break;
385 
              case ROUND_DOWN:
386 
                p = "DOWN";
387 
                break;
388 
              case ROUND_ZERO:
389 
                p = "ZERO";
390 
                break;
391 
              case ROUND_NEAREST:
392 
                p = "NEAREST";
393 
                break;
394 
              case ROUND_COMPATIBLE:
395 
                p = "COMPATIBLE";
396 
                break;
397 
              case ROUND_PROCDEFINED:
398 
                p = "PROCESSOR_DEFINED";
399 
                break;
400 
              default:
401 
                internal_error (&iqp->common, "inquire_via_unit(): Bad round");
402 
            }
403 
 
404 
          cf_strcpy (iqp->round, iqp->round_len, p);
405 
        }
406 
 
407 
      if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
408 
        {
409 
          if (u == NULL)
410 
            *iqp->size = -1;
411 
          else
412 
            {
413 
              sflush (u->s);
414 
              *iqp->size = ssize (u->s);
415 
            }
416 
        }
417 
    }
418 
 
419 
  if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
420 
    {
421 
      if (u == NULL || u->flags.access == ACCESS_DIRECT)
422 
        p = undefined;
423 
      else
424 
        {
425 
          /* If the position is unspecified, check if we can figure
426 
             out whether it's at the beginning or end.  */
427 
          if (u->flags.position == POSITION_UNSPECIFIED)
428 
            {
429 
              gfc_offset cur = stell (u->s);
430 
              if (cur == 0)
431 
                u->flags.position = POSITION_REWIND;
432 
              else if (cur != -1 && (ssize (u->s) == cur))
433 
                u->flags.position = POSITION_APPEND;
434 
            }
435 
          switch (u->flags.position)
436 
            {
437 
            case POSITION_REWIND:
438 
              p = "REWIND";
439 
              break;
440 
            case POSITION_APPEND:
441 
              p = "APPEND";
442 
              break;
443 
            case POSITION_ASIS:
444 
              p = "ASIS";
445 
              break;
446 
            default:
447 
              /* If the position has changed and is not rewind or
448 
                 append, it must be set to a processor-dependent
449 
                 value.  */
450 
              p = "UNSPECIFIED";
451 
              break;
452 
            }
453 
        }
454 
      cf_strcpy (iqp->position, iqp->position_len, p);
455 
    }
456 
 
457 
  if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
458 
    {
459 
      if (u == NULL)
460 
        p = undefined;
461 
      else
462 
        switch (u->flags.action)
463 
          {
464 
          case ACTION_READ:
465 
            p = "READ";
466 
            break;
467 
          case ACTION_WRITE:
468 
            p = "WRITE";
469 
            break;
470 
          case ACTION_READWRITE:
471 
            p = "READWRITE";
472 
            break;
473 
          default:
474 
            internal_error (&iqp->common, "inquire_via_unit(): Bad action");
475 
          }
476 
 
477 
      cf_strcpy (iqp->action, iqp->action_len, p);
478 
    }
479 
 
480 
  if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
481 
    {
482 
      p = (u == NULL) ? inquire_read (NULL, 0) :
483 
        inquire_read (u->file, u->file_len);
484 
 
485 
      cf_strcpy (iqp->read, iqp->read_len, p);
486 
    }
487 
 
488 
  if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
489 
    {
490 
      p = (u == NULL) ? inquire_write (NULL, 0) :
491 
        inquire_write (u->file, u->file_len);
492 
 
493 
      cf_strcpy (iqp->write, iqp->write_len, p);
494 
    }
495 
 
496 
  if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
497 
    {
498 
      p = (u == NULL) ? inquire_readwrite (NULL, 0) :
499 
        inquire_readwrite (u->file, u->file_len);
500 
 
501 
      cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
502 
    }
503 
 
504 
  if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
505 
    {
506 
      if (u == NULL || u->flags.form != FORM_FORMATTED)
507 
        p = undefined;
508 
      else
509 
        switch (u->flags.delim)
510 
          {
511 
          case DELIM_NONE:
512 
            p = "NONE";
513 
            break;
514 
          case DELIM_QUOTE:
515 
            p = "QUOTE";
516 
            break;
517 
          case DELIM_APOSTROPHE:
518 
            p = "APOSTROPHE";
519 
            break;
520 
          default:
521 
            internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
522 
          }
523 
 
524 
      cf_strcpy (iqp->delim, iqp->delim_len, p);
525 
    }
526 
 
527 
  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
528 
    {
529 
      if (u == NULL || u->flags.form != FORM_FORMATTED)
530 
        p = undefined;
531 
      else
532 
        switch (u->flags.pad)
533 
          {
534 
          case PAD_NO:
535 
            p = "NO";
536 
            break;
537 
          case PAD_YES:
538 
            p = "YES";
539 
            break;
540 
          default:
541 
            internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
542 
          }
543 
 
544 
      cf_strcpy (iqp->pad, iqp->pad_len, p);
545 
    }
546 
 
547 
  if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
548 
    {
549 
      if (u == NULL)
550 
        p = undefined;
551 
      else
552 
        switch (u->flags.convert)
553 
          {
554 
            /*  big_endian is 0 for little-endian, 1 for big-endian.  */
555 
          case GFC_CONVERT_NATIVE:
556 
            p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
557 
            break;
558 
 
559 
          case GFC_CONVERT_SWAP:
560 
            p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
561 
            break;
562 
 
563 
          default:
564 
            internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
565 
          }
566 
 
567 
      cf_strcpy (iqp->convert, iqp->convert_len, p);
568 
    }
569 
}
570 
 
571 
 
572 
/* inquire_via_filename()-- Inquiry via filename.  This subroutine is
573 
 * only used if the filename is *not* connected to a unit number. */
574 
 
575 
static void
576 
inquire_via_filename (st_parameter_inquire *iqp)
577 
{
578 
  const char *p;
579 
  GFC_INTEGER_4 cf = iqp->common.flags;
580 
 
581 
  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
582 
    *iqp->exist = file_exists (iqp->file, iqp->file_len);
583 
 
584 
  if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
585 
    *iqp->opened = 0;
586 
 
587 
  if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
588 
    *iqp->number = -1;
589 
 
590 
  if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
591 
    *iqp->named = 1;
592 
 
593 
  if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
594 
    fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
595 
 
596 
  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
597 
    cf_strcpy (iqp->access, iqp->access_len, undefined);
598 
 
599 
  if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
600 
    {
601 
      p = "UNKNOWN";
602 
      cf_strcpy (iqp->sequential, iqp->sequential_len, p);
603 
    }
604 
 
605 
  if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
606 
    {
607 
      p = "UNKNOWN";
608 
      cf_strcpy (iqp->direct, iqp->direct_len, p);
609 
    }
610 
 
611 
  if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
612 
    cf_strcpy (iqp->form, iqp->form_len, undefined);
613 
 
614 
  if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
615 
    {
616 
      p = "UNKNOWN";
617 
      cf_strcpy (iqp->formatted, iqp->formatted_len, p);
618 
    }
619 
 
620 
  if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
621 
    {
622 
      p = "UNKNOWN";
623 
      cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
624 
    }
625 
 
626 
  if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
627 
    *iqp->recl_out = 0;
628 
 
629 
  if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
630 
    *iqp->nextrec = 0;
631 
 
632 
  if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
633 
    cf_strcpy (iqp->blank, iqp->blank_len, undefined);
634 
 
635 
  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
636 
    cf_strcpy (iqp->pad, iqp->pad_len, undefined);
637 
 
638 
  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
639 
    {
640 
      GFC_INTEGER_4 cf2 = iqp->flags2;
641 
 
642 
      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
643 
        cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
644 
 
645 
      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
646 
        cf_strcpy (iqp->delim, iqp->delim_len, undefined);
647 
 
648 
      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
649 
        cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
650 
 
651 
      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
652 
        cf_strcpy (iqp->delim, iqp->delim_len, undefined);
653 
 
654 
      if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
655 
        cf_strcpy (iqp->pad, iqp->pad_len, undefined);
656 
 
657 
      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
658 
        cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
659 
 
660 
      if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
661 
        *iqp->size = file_size (iqp->file, iqp->file_len);
662 
    }
663 
 
664 
  if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
665 
    cf_strcpy (iqp->position, iqp->position_len, undefined);
666 
 
667 
  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
668 
    cf_strcpy (iqp->access, iqp->access_len, undefined);
669 
 
670 
  if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
671 
    {
672 
      p = inquire_read (iqp->file, iqp->file_len);
673 
      cf_strcpy (iqp->read, iqp->read_len, p);
674 
    }
675 
 
676 
  if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
677 
    {
678 
      p = inquire_write (iqp->file, iqp->file_len);
679 
      cf_strcpy (iqp->write, iqp->write_len, p);
680 
    }
681 
 
682 
  if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
683 
    {
684 
      p = inquire_read (iqp->file, iqp->file_len);
685 
      cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
686 
    }
687 
}
688 
 
689 
 
690 
/* Library entry point for the INQUIRE statement (non-IOLENGTH
691 
   form).  */
692 
 
693 
extern void st_inquire (st_parameter_inquire *);
694 
export_proto(st_inquire);
695 
 
696 
void
697 
st_inquire (st_parameter_inquire *iqp)
698 
{
699 
  gfc_unit *u;
700 
 
701 
  library_start (&iqp->common);
702 
 
703 
  if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
704 
    {
705 
      u = find_unit (iqp->common.unit);
706 
      inquire_via_unit (iqp, u);
707 
    }
708 
  else
709 
    {
710 
      u = find_file (iqp->file, iqp->file_len);
711 
      if (u == NULL)
712 
        inquire_via_filename (iqp);
713 
      else
714 
        inquire_via_unit (iqp, u);
715 
    }
716 
  if (u != NULL)
717 
    unlock_unit (u);
718 
 
719 
  library_end ();
720 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.