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 733

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.