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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [io/] [io.h] - Blame information for rev 758

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

Line No. Rev Author Line
1 733 jeremybenn
/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
2
   2011
3
   Free Software Foundation, Inc.
4
   Contributed by Andy Vaught
5
   F2003 I/O support contributed by Jerry DeLisle
6
 
7
This file is part of the GNU Fortran 95 runtime library (libgfortran).
8
 
9
Libgfortran is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 3, or (at your option)
12
any later version.
13
 
14
Libgfortran is distributed in the hope that it will be useful,
15
but WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17
GNU General Public License for more details.
18
 
19
Under Section 7 of GPL version 3, you are granted additional
20
permissions described in the GCC Runtime Library Exception, version
21
3.1, as published by the Free Software Foundation.
22
 
23
You should have received a copy of the GNU General Public License and
24
a copy of the GCC Runtime Library Exception along with this program;
25
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
26
<http://www.gnu.org/licenses/>.  */
27
 
28
#ifndef GFOR_IO_H
29
#define GFOR_IO_H
30
 
31
/* IO library include.  */
32
 
33
#include "libgfortran.h"
34
 
35
#include <gthr.h>
36
 
37
/* Forward declarations.  */
38
struct st_parameter_dt;
39
typedef struct stream stream;
40
struct fbuf;
41
struct format_data;
42
typedef struct fnode fnode;
43
struct gfc_unit;
44
 
45
 
46
/* Macros for testing what kinds of I/O we are doing.  */
47
 
48
#define is_array_io(dtp) ((dtp)->internal_unit_desc)
49
 
50
#define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
51
 
52
#define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
53
 
54
#define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit)
55
 
56
/* The array_loop_spec contains the variables for the loops over index ranges
57
   that are encountered.  */
58
 
59
typedef struct array_loop_spec
60
{
61
  /* Index counter for this dimension.  */
62
  index_type idx;
63
 
64
  /* Start for the index counter.  */
65
  index_type start;
66
 
67
  /* End for the index counter.  */
68
  index_type end;
69
 
70
  /* Step for the index counter.  */
71
  index_type step;
72
}
73
array_loop_spec;
74
 
75
/* A stucture to build a hash table for format data.  */
76
 
77
#define FORMAT_HASH_SIZE 16
78
 
79
typedef struct format_hash_entry
80
{
81
  char *key;
82
  gfc_charlen_type key_len;
83
  struct format_data *hashed_fmt;
84
}
85
format_hash_entry;
86
 
87
/* Representation of a namelist object in libgfortran
88
 
89
   Namelist Records
90
      &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
91
     or
92
      &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
93
 
94
   The object can be a fully qualified, compound name for an intrinsic
95
   type, derived types or derived type components.  So, a substring
96
   a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
97
   read. Hence full information about the structure of the object has
98
   to be available to list_read.c and write.
99
 
100
   These requirements are met by the following data structures.
101
 
102
   namelist_info type contains all the scalar information about the
103
   object and arrays of descriptor_dimension and array_loop_spec types for
104
   arrays.  */
105
 
106
typedef struct namelist_type
107
{
108
  /* Object type.  */
109
  bt type;
110
 
111
  /* Object name.  */
112
  char * var_name;
113
 
114
  /* Address for the start of the object's data.  */
115
  void * mem_pos;
116
 
117
  /* Flag to show that a read is to be attempted for this node.  */
118
  int touched;
119
 
120
  /* Length of intrinsic type in bytes.  */
121
  int len;
122
 
123
  /* Rank of the object.  */
124
  int var_rank;
125
 
126
  /* Overall size of the object in bytes.  */
127
  index_type size;
128
 
129
  /* Length of character string.  */
130
  index_type string_length;
131
 
132
  descriptor_dimension * dim;
133
  array_loop_spec * ls;
134
  struct namelist_type * next;
135
}
136
namelist_info;
137
 
138
/* Options for the OPEN statement.  */
139
 
140
typedef enum
141
{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
142
  ACCESS_UNSPECIFIED
143
}
144
unit_access;
145
 
146
typedef enum
147
{ ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
148
  ACTION_UNSPECIFIED
149
}
150
unit_action;
151
 
152
typedef enum
153
{ BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
154
unit_blank;
155
 
156
typedef enum
157
{ DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
158
  DELIM_UNSPECIFIED
159
}
160
unit_delim;
161
 
162
typedef enum
163
{ FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
164
unit_form;
165
 
166
typedef enum
167
{ POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
168
  POSITION_UNSPECIFIED
169
}
170
unit_position;
171
 
172
typedef enum
173
{ STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
174
  STATUS_REPLACE, STATUS_UNSPECIFIED
175
}
176
unit_status;
177
 
178
typedef enum
179
{ PAD_YES, PAD_NO, PAD_UNSPECIFIED }
180
unit_pad;
181
 
182
typedef enum
183
{ DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
184
unit_decimal;
185
 
186
typedef enum
187
{ ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
188
unit_encoding;
189
 
190
typedef enum
191
{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
192
  ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
193
unit_round;
194
 
195
/* NOTE: unit_sign must correspond with the sign_status enumerator in
196
   st_parameter_dt to not break the ABI.  */
197
typedef enum
198
{ SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED }
199
unit_sign;
200
 
201
typedef enum
202
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
203
unit_advance;
204
 
205
typedef enum
206
{READING, WRITING}
207
unit_mode;
208
 
209
typedef enum
210
{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
211
unit_async;
212
 
213
typedef enum
214
{ SIGN_S, SIGN_SS, SIGN_SP }
215
unit_sign_s;
216
 
217
#define CHARACTER1(name) \
218
              char * name; \
219
              gfc_charlen_type name ## _len
220
#define CHARACTER2(name) \
221
              gfc_charlen_type name ## _len; \
222
              char * name
223
 
224
typedef struct
225
{
226
  st_parameter_common common;
227
  GFC_INTEGER_4 recl_in;
228
  CHARACTER2 (file);
229
  CHARACTER1 (status);
230
  CHARACTER2 (access);
231
  CHARACTER1 (form);
232
  CHARACTER2 (blank);
233
  CHARACTER1 (position);
234
  CHARACTER2 (action);
235
  CHARACTER1 (delim);
236
  CHARACTER2 (pad);
237
  CHARACTER1 (convert);
238
  CHARACTER2 (decimal);
239
  CHARACTER1 (encoding);
240
  CHARACTER2 (round);
241
  CHARACTER1 (sign);
242
  CHARACTER2 (asynchronous);
243
  GFC_INTEGER_4 *newunit;
244
}
245
st_parameter_open;
246
 
247
#define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
248
 
249
typedef struct
250
{
251
  st_parameter_common common;
252
  CHARACTER1 (status);
253
}
254
st_parameter_close;
255
 
256
typedef struct
257
{
258
  st_parameter_common common;
259
}
260
st_parameter_filepos;
261
 
262
#define IOPARM_INQUIRE_HAS_EXIST        (1 << 7)
263
#define IOPARM_INQUIRE_HAS_OPENED       (1 << 8)
264
#define IOPARM_INQUIRE_HAS_NUMBER       (1 << 9)
265
#define IOPARM_INQUIRE_HAS_NAMED        (1 << 10)
266
#define IOPARM_INQUIRE_HAS_NEXTREC      (1 << 11)
267
#define IOPARM_INQUIRE_HAS_RECL_OUT     (1 << 12)
268
#define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
269
#define IOPARM_INQUIRE_HAS_FILE         (1 << 14)
270
#define IOPARM_INQUIRE_HAS_ACCESS       (1 << 15)
271
#define IOPARM_INQUIRE_HAS_FORM         (1 << 16)
272
#define IOPARM_INQUIRE_HAS_BLANK        (1 << 17)
273
#define IOPARM_INQUIRE_HAS_POSITION     (1 << 18)
274
#define IOPARM_INQUIRE_HAS_ACTION       (1 << 19)
275
#define IOPARM_INQUIRE_HAS_DELIM        (1 << 20)
276
#define IOPARM_INQUIRE_HAS_PAD          (1 << 21)
277
#define IOPARM_INQUIRE_HAS_NAME         (1 << 22)
278
#define IOPARM_INQUIRE_HAS_SEQUENTIAL   (1 << 23)
279
#define IOPARM_INQUIRE_HAS_DIRECT       (1 << 24)
280
#define IOPARM_INQUIRE_HAS_FORMATTED    (1 << 25)
281
#define IOPARM_INQUIRE_HAS_UNFORMATTED  (1 << 26)
282
#define IOPARM_INQUIRE_HAS_READ         (1 << 27)
283
#define IOPARM_INQUIRE_HAS_WRITE        (1 << 28)
284
#define IOPARM_INQUIRE_HAS_READWRITE    (1 << 29)
285
#define IOPARM_INQUIRE_HAS_CONVERT      (1 << 30)
286
#define IOPARM_INQUIRE_HAS_FLAGS2       (1 << 31)
287
 
288
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
289
#define IOPARM_INQUIRE_HAS_DECIMAL      (1 << 1)
290
#define IOPARM_INQUIRE_HAS_ENCODING     (1 << 2)
291
#define IOPARM_INQUIRE_HAS_ROUND        (1 << 3)
292
#define IOPARM_INQUIRE_HAS_SIGN         (1 << 4)
293
#define IOPARM_INQUIRE_HAS_PENDING      (1 << 5)
294
#define IOPARM_INQUIRE_HAS_SIZE         (1 << 6)
295
#define IOPARM_INQUIRE_HAS_ID           (1 << 7)
296
 
297
typedef struct
298
{
299
  st_parameter_common common;
300
  GFC_INTEGER_4 *exist, *opened, *number, *named;
301
  GFC_INTEGER_4 *nextrec, *recl_out;
302
  GFC_IO_INT *strm_pos_out;
303
  CHARACTER1 (file);
304
  CHARACTER2 (access);
305
  CHARACTER1 (form);
306
  CHARACTER2 (blank);
307
  CHARACTER1 (position);
308
  CHARACTER2 (action);
309
  CHARACTER1 (delim);
310
  CHARACTER2 (pad);
311
  CHARACTER1 (name);
312
  CHARACTER2 (sequential);
313
  CHARACTER1 (direct);
314
  CHARACTER2 (formatted);
315
  CHARACTER1 (unformatted);
316
  CHARACTER2 (read);
317
  CHARACTER1 (write);
318
  CHARACTER2 (readwrite);
319
  CHARACTER1 (convert);
320
  GFC_INTEGER_4 flags2;
321
  CHARACTER1 (asynchronous);
322
  CHARACTER2 (decimal);
323
  CHARACTER1 (encoding);
324
  CHARACTER2 (round);
325
  CHARACTER1 (sign);
326
  GFC_INTEGER_4 *pending;
327
  GFC_IO_INT *size;
328
  GFC_INTEGER_4 *id;
329
}
330
st_parameter_inquire;
331
 
332
 
333
#define IOPARM_DT_LIST_FORMAT                   (1 << 7)
334
#define IOPARM_DT_NAMELIST_READ_MODE            (1 << 8)
335
#define IOPARM_DT_HAS_REC                       (1 << 9)
336
#define IOPARM_DT_HAS_SIZE                      (1 << 10)
337
#define IOPARM_DT_HAS_IOLENGTH                  (1 << 11)
338
#define IOPARM_DT_HAS_FORMAT                    (1 << 12)
339
#define IOPARM_DT_HAS_ADVANCE                   (1 << 13)
340
#define IOPARM_DT_HAS_INTERNAL_UNIT             (1 << 14)
341
#define IOPARM_DT_HAS_NAMELIST_NAME             (1 << 15)
342
#define IOPARM_DT_HAS_ID                        (1 << 16)
343
#define IOPARM_DT_HAS_POS                       (1 << 17)
344
#define IOPARM_DT_HAS_ASYNCHRONOUS              (1 << 18)
345
#define IOPARM_DT_HAS_BLANK                     (1 << 19)
346
#define IOPARM_DT_HAS_DECIMAL                   (1 << 20)
347
#define IOPARM_DT_HAS_DELIM                     (1 << 21)
348
#define IOPARM_DT_HAS_PAD                       (1 << 22)
349
#define IOPARM_DT_HAS_ROUND                     (1 << 23)
350
#define IOPARM_DT_HAS_SIGN                      (1 << 24)
351
#define IOPARM_DT_HAS_F2003                     (1 << 25)
352
/* Internal use bit.  */
353
#define IOPARM_DT_IONML_SET                     (1 << 31)
354
 
355
 
356
typedef struct st_parameter_dt
357
{
358
  st_parameter_common common;
359
  GFC_IO_INT rec;
360
  GFC_IO_INT *size, *iolength;
361
  gfc_array_char *internal_unit_desc;
362
  CHARACTER1 (format);
363
  CHARACTER2 (advance);
364
  CHARACTER1 (internal_unit);
365
  CHARACTER2 (namelist_name);
366
  /* Private part of the structure.  The compiler just needs
367
     to reserve enough space.  */
368
  union
369
    {
370
      struct
371
        {
372
          void (*transfer) (struct st_parameter_dt *, bt, void *, int,
373
                            size_t, size_t);
374
          struct gfc_unit *current_unit;
375
          /* Item number in a formatted data transfer.  Also used in namelist
376
             read_logical as an index into line_buffer.  */
377
          int item_count;
378
          unit_mode mode;
379
          unit_blank blank_status;
380
          unit_sign sign_status;
381
          int scale_factor;
382
          int max_pos; /* Maximum righthand column written to.  */
383
          /* Number of skips + spaces to be done for T and X-editing.  */
384
          int skips;
385
          /* Number of spaces to be done for T and X-editing.  */
386
          int pending_spaces;
387
          /* Whether an EOR condition was encountered. Value is:
388
 
389
               1 if an EOR was encountered due to a 1-byte marker (LF)
390
               2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
391
          int sf_seen_eor;
392
          unit_advance advance_status;
393
          unsigned reversion_flag : 1; /* Format reversion has occurred.  */
394
          unsigned first_item : 1;
395
          unsigned seen_dollar : 1;
396
          unsigned eor_condition : 1;
397
          unsigned no_leading_blank : 1;
398
          unsigned char_flag : 1;
399
          unsigned input_complete : 1;
400
          unsigned at_eol : 1;
401
          unsigned comma_flag : 1;
402
          /* A namelist specific flag used in the list directed library
403
             to flag that calls are being made from namelist read (eg. to
404
             ignore comments or to treat '/' as a terminator)  */
405
          unsigned namelist_mode : 1;
406
          /* A namelist specific flag used in the list directed library
407
             to flag read errors and return, so that an attempt can be
408
             made to read a new object name.  */
409
          unsigned nml_read_error : 1;
410
          /* A sequential formatted read specific flag used to signal that a
411
             character string is being read so don't use commas to shorten a
412
             formatted field width.  */
413
          unsigned sf_read_comma : 1;
414
          /* A namelist specific flag used to enable reading input from
415
             line_buffer for logical reads.  */
416
          unsigned line_buffer_enabled : 1;
417
          /* An internal unit specific flag used to identify that the associated
418
             unit is internal.  */
419
          unsigned unit_is_internal : 1;
420
          /* An internal unit specific flag to signify an EOF condition for list
421
             directed read.  */
422
          unsigned at_eof : 1;
423
          /* Used for g0 floating point output.  */
424
          unsigned g0_no_blanks : 1;
425
          /* Used to signal use of free_format_data.  */
426
          unsigned format_not_saved : 1;
427
          /* 14 unused bits.  */
428
 
429
          /* Used for ungetc() style functionality. Possible values
430
             are an unsigned char, EOF, or EOF - 1 used to mark the
431
             field as not valid.  */
432
          int last_char;
433
          char nml_delim;
434
 
435
          int repeat_count;
436
          int saved_length;
437
          int saved_used;
438
          bt saved_type;
439
          char *saved_string;
440
          char *scratch;
441
          char *line_buffer;
442
          struct format_data *fmt;
443
          namelist_info *ionml;
444
          /* A flag used to identify when a non-standard expanded namelist read
445
             has occurred.  */
446
          int expanded_read;
447
          /* Storage area for values except for strings.  Must be
448
             large enough to hold a complex value (two reals) of the
449
             largest kind.  */
450
          char value[32];
451
          GFC_IO_INT size_used;
452
        } p;
453
      /* This pad size must be equal to the pad_size declared in
454
         trans-io.c (gfc_build_io_library_fndecls).  The above structure
455
         must be smaller or equal to this array.  */
456
      char pad[16 * sizeof (char *) + 32 * sizeof (int)];
457
    } u;
458
  GFC_INTEGER_4 *id;
459
  GFC_IO_INT pos;
460
  CHARACTER1 (asynchronous);
461
  CHARACTER2 (blank);
462
  CHARACTER1 (decimal);
463
  CHARACTER2 (delim);
464
  CHARACTER1 (pad);
465
  CHARACTER2 (round);
466
  CHARACTER1 (sign);
467
}
468
st_parameter_dt;
469
 
470
/* Ensure st_parameter_dt's u.pad is bigger or equal to u.p.  */
471
extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
472
                                  >= sizeof (((st_parameter_dt *) 0)->u.p)
473
                                  ? 1 : -1];
474
 
475
#define IOPARM_WAIT_HAS_ID              (1 << 7)
476
 
477
typedef struct
478
{
479
  st_parameter_common common;
480
  CHARACTER1 (id);
481
}
482
st_parameter_wait;
483
 
484
 
485
#undef CHARACTER1
486
#undef CHARACTER2
487
 
488
typedef struct
489
{
490
  unit_access access;
491
  unit_action action;
492
  unit_blank blank;
493
  unit_delim delim;
494
  unit_form form;
495
  int is_notpadded;
496
  unit_position position;
497
  unit_status status;
498
  unit_pad pad;
499
  unit_convert convert;
500
  int has_recl;
501
  unit_decimal decimal;
502
  unit_encoding encoding;
503
  unit_round round;
504
  unit_sign sign;
505
  unit_async async;
506
}
507
unit_flags;
508
 
509
 
510
typedef struct gfc_unit
511
{
512
  int unit_number;
513
  stream *s;
514
 
515
  /* Treap links.  */
516
  struct gfc_unit *left, *right;
517
  int priority;
518
 
519
  int read_bad, current_record, saved_pos, previous_nonadvancing_write;
520
 
521
  enum
522
  { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
523
  endfile;
524
 
525
  unit_mode mode;
526
  unit_flags flags;
527
  unit_pad pad_status;
528
  unit_decimal decimal_status;
529
  unit_delim delim_status;
530
  unit_round round_status;
531
 
532
  /* recl                 -- Record length of the file.
533
     last_record          -- Last record number read or written
534
     maxrec               -- Maximum record number in a direct access file
535
     bytes_left           -- Bytes left in current record.
536
     strm_pos             -- Current position in file for STREAM I/O.
537
     recl_subrecord       -- Maximum length for subrecord.
538
     bytes_left_subrecord -- Bytes left in current subrecord.  */
539
  gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
540
    recl_subrecord, bytes_left_subrecord;
541
 
542
  /* Set to 1 if we have read a subrecord.  */
543
 
544
  int continued;
545
 
546
  __gthread_mutex_t lock;
547
  /* Number of threads waiting to acquire this unit's lock.
548
     When non-zero, close_unit doesn't only removes the unit
549
     from the UNIT_ROOT tree, but doesn't free it and the
550
     last of the waiting threads will do that.
551
     This must be either atomically increased/decreased, or
552
     always guarded by UNIT_LOCK.  */
553
  int waiting;
554
  /* Flag set by close_unit if the unit as been closed.
555
     Must be manipulated under unit's lock.  */
556
  int closed;
557
 
558
  /* For traversing arrays */
559
  array_loop_spec *ls;
560
  int rank;
561
 
562
  int file_len;
563
  char *file;
564
 
565
  /* The format hash table.  */
566
  struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
567
 
568
  /* Formatting buffer.  */
569
  struct fbuf *fbuf;
570
}
571
gfc_unit;
572
 
573
 
574
/* unit.c */
575
 
576
/* Maximum file offset, computed at library initialization time.  */
577
extern gfc_offset max_offset;
578
internal_proto(max_offset);
579
 
580
/* Unit tree root.  */
581
extern gfc_unit *unit_root;
582
internal_proto(unit_root);
583
 
584
extern __gthread_mutex_t unit_lock;
585
internal_proto(unit_lock);
586
 
587
extern int close_unit (gfc_unit *);
588
internal_proto(close_unit);
589
 
590
extern gfc_unit *get_internal_unit (st_parameter_dt *);
591
internal_proto(get_internal_unit);
592
 
593
extern void free_internal_unit (st_parameter_dt *);
594
internal_proto(free_internal_unit);
595
 
596
extern gfc_unit *find_unit (int);
597
internal_proto(find_unit);
598
 
599
extern gfc_unit *find_or_create_unit (int);
600
internal_proto(find_or_create_unit);
601
 
602
extern gfc_unit *get_unit (st_parameter_dt *, int);
603
internal_proto(get_unit);
604
 
605
extern void unlock_unit (gfc_unit *);
606
internal_proto(unlock_unit);
607
 
608
extern void finish_last_advance_record (gfc_unit *u);
609
internal_proto (finish_last_advance_record);
610
 
611
extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
612
internal_proto (unit_truncate);
613
 
614
extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
615
internal_proto(get_unique_unit_number);
616
 
617
/* open.c */
618
 
619
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
620
internal_proto(new_unit);
621
 
622
 
623
/* transfer.c */
624
 
625
#define SCRATCH_SIZE 300
626
 
627
extern const char *type_name (bt);
628
internal_proto(type_name);
629
 
630
extern void * read_block_form (st_parameter_dt *, int *);
631
internal_proto(read_block_form);
632
 
633
extern void * read_block_form4 (st_parameter_dt *, int *);
634
internal_proto(read_block_form4);
635
 
636
extern void *write_block (st_parameter_dt *, int);
637
internal_proto(write_block);
638
 
639
extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
640
                                     int*);
641
internal_proto(next_array_record);
642
 
643
extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
644
                                  gfc_offset *);
645
internal_proto(init_loop_spec);
646
 
647
extern void next_record (st_parameter_dt *, int);
648
internal_proto(next_record);
649
 
650
extern void reverse_memcpy (void *, const void *, size_t);
651
internal_proto (reverse_memcpy);
652
 
653
extern void st_wait (st_parameter_wait *);
654
export_proto(st_wait);
655
 
656
extern void hit_eof (st_parameter_dt *);
657
internal_proto(hit_eof);
658
 
659
/* read.c */
660
 
661
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
662
internal_proto(set_integer);
663
 
664
extern GFC_UINTEGER_LARGEST max_value (int, int);
665
internal_proto(max_value);
666
 
667
extern int convert_real (st_parameter_dt *, void *, const char *, int);
668
internal_proto(convert_real);
669
 
670
extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
671
internal_proto(convert_infnan);
672
 
673
extern void read_a (st_parameter_dt *, const fnode *, char *, int);
674
internal_proto(read_a);
675
 
676
extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
677
internal_proto(read_a);
678
 
679
extern void read_f (st_parameter_dt *, const fnode *, char *, int);
680
internal_proto(read_f);
681
 
682
extern void read_l (st_parameter_dt *, const fnode *, char *, int);
683
internal_proto(read_l);
684
 
685
extern void read_x (st_parameter_dt *, int);
686
internal_proto(read_x);
687
 
688
extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
689
internal_proto(read_radix);
690
 
691
extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
692
internal_proto(read_decimal);
693
 
694
/* list_read.c */
695
 
696
extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
697
                                 size_t);
698
internal_proto(list_formatted_read);
699
 
700
extern void finish_list_read (st_parameter_dt *);
701
internal_proto(finish_list_read);
702
 
703
extern void namelist_read (st_parameter_dt *);
704
internal_proto(namelist_read);
705
 
706
extern void namelist_write (st_parameter_dt *);
707
internal_proto(namelist_write);
708
 
709
/* write.c */
710
 
711
extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
712
internal_proto(write_a);
713
 
714
extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
715
internal_proto(write_a_char4);
716
 
717
extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
718
internal_proto(write_b);
719
 
720
extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
721
internal_proto(write_d);
722
 
723
extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
724
internal_proto(write_e);
725
 
726
extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
727
internal_proto(write_en);
728
 
729
extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
730
internal_proto(write_es);
731
 
732
extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
733
internal_proto(write_f);
734
 
735
extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
736
internal_proto(write_i);
737
 
738
extern void write_l (st_parameter_dt *, const fnode *, char *, int);
739
internal_proto(write_l);
740
 
741
extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
742
internal_proto(write_o);
743
 
744
extern void write_real (st_parameter_dt *, const char *, int);
745
internal_proto(write_real);
746
 
747
extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
748
internal_proto(write_real_g0);
749
 
750
extern void write_x (st_parameter_dt *, int, int);
751
internal_proto(write_x);
752
 
753
extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
754
internal_proto(write_z);
755
 
756
extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
757
                                  size_t);
758
internal_proto(list_formatted_write);
759
 
760
/* size_from_kind.c */
761
extern size_t size_from_real_kind (int);
762
internal_proto(size_from_real_kind);
763
 
764
extern size_t size_from_complex_kind (int);
765
internal_proto(size_from_complex_kind);
766
 
767
 
768
/* lock.c */
769
extern void free_ionml (st_parameter_dt *);
770
internal_proto(free_ionml);
771
 
772
static inline void
773
inc_waiting_locked (gfc_unit *u)
774
{
775
#ifdef HAVE_SYNC_FETCH_AND_ADD
776
  (void) __sync_fetch_and_add (&u->waiting, 1);
777
#else
778
  u->waiting++;
779
#endif
780
}
781
 
782
static inline int
783
predec_waiting_locked (gfc_unit *u)
784
{
785
#ifdef HAVE_SYNC_FETCH_AND_ADD
786
  return __sync_add_and_fetch (&u->waiting, -1);
787
#else
788
  return --u->waiting;
789
#endif
790
}
791
 
792
static inline void
793
dec_waiting_unlocked (gfc_unit *u)
794
{
795
#ifdef HAVE_SYNC_FETCH_AND_ADD
796
  (void) __sync_fetch_and_add (&u->waiting, -1);
797
#else
798
  __gthread_mutex_lock (&unit_lock);
799
  u->waiting--;
800
  __gthread_mutex_unlock (&unit_lock);
801
#endif
802
}
803
 
804
 
805
static inline void
806
memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
807
{
808
  int j;
809
  for (j = 0; j < k; j++)
810
    *p++ = c;
811
}
812
 
813
#endif
814
 

powered by: WebSVN 2.1.0

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