2 /* Copyright (C) 2002-2003 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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 2, or (at your option)
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.
17 You should have received a copy of the GNU General Public License
18 along with Libgfortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* transfer.c -- Top level handling of data transfer statements. */
27 #include "libgfortran.h"
31 /* Calling conventions: Data transfer statements are unlike other
32 * library calls in that they extend over several calls.
34 * The first call is always a call to st_read() or st_write(). These
35 * subroutines return no status unless a namelist read or write is
36 * being done, in which case there is the usual status. No further
37 * calls are necessary in this case.
39 * For other sorts of data transfer, there are zero or more data
40 * transfer statement that depend on the format of the data transfer
49 * These subroutines do not return status.
51 * The last call is a call to st_[read|write]_done(). While
52 * something can easily go wrong with the initial st_read() or
53 * st_write(), an error inhibits any data from actually being
58 static int sf_seen_eor = 0;
60 char scratch[SCRATCH_SIZE];
61 static char *line_buffer = NULL;
63 static unit_advance advance_status;
65 static st_option advance_opt[] = {
72 static void (*transfer) (bt, void *, int);
76 { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
77 FORMATTED_DIRECT, UNFORMATTED_DIRECT
87 if (current_unit->flags.access == ACCESS_DIRECT)
89 m = current_unit->flags.form == FORM_FORMATTED ?
90 FORMATTED_DIRECT : UNFORMATTED_DIRECT;
94 m = current_unit->flags.form == FORM_FORMATTED ?
95 FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL;
102 /* Mid level data transfer statements. These subroutines do reading
103 * and writing in the style of salloc_r()/salloc_w() within the
106 /* read_sf()-- When reading sequential formatted records we have a
107 * problem. We don't know how long the line is until we read the
108 * trailing newline, and we don't want to read too much. If we read
109 * too much, we might have to do a physical seek backwards depending
110 * on how much data is present, and devices like terminals aren't
111 * seekable and would cause an I/O error.
113 * Given this, the solution is to read a byte at a time, stopping if
114 * we hit the newline. For small locations, we use a static buffer.
115 * For larger allocations, we are forced to allocate memory on the
116 * heap. Hopefully this won't happen very often. */
119 read_sf (int *length)
121 static char data[SCRATCH_SIZE];
125 if (*length > SCRATCH_SIZE)
126 p = base = line_buffer = get_mem (*length);
130 memset(base,'\0',*length);
132 current_unit->bytes_left = options.default_recl;
138 if (is_internal_unit())
140 /* unity may be modified inside salloc_r if is_internal_unit() is true */
144 q = salloc_r (current_unit->s, &unity);
150 if (current_unit->unit_number == options.stdin_unit)
155 /* Unexpected end of line */
156 if (current_unit->flags.pad == PAD_NO)
158 generate_error (ERROR_EOR, NULL);
162 current_unit->bytes_left = 0;
178 /* read_block()-- Function for reading the next couple of bytes from
179 * the current file, advancing the current position. We return a
180 * pointer to a buffer containing the bytes. We return NULL on end of
181 * record or end of file.
183 * If the read is short, then it is because the current record does not
184 * have enough data to satisfy the read request and the file was
185 * opened with PAD=YES. The caller must assume tailing spaces for
189 read_block (int *length)
194 if (current_unit->flags.form == FORM_FORMATTED &&
195 current_unit->flags.access == ACCESS_SEQUENTIAL)
196 return read_sf (length); /* Special case */
198 if (current_unit->bytes_left < *length)
200 if (current_unit->flags.pad == PAD_NO)
202 generate_error (ERROR_EOR, NULL); /* Not enough data left */
206 *length = current_unit->bytes_left;
209 current_unit->bytes_left -= *length;
212 source = salloc_r (current_unit->s, &nread);
214 if (ioparm.size != NULL)
215 *ioparm.size += nread;
217 if (nread != *length)
218 { /* Short read, this shouldn't happen */
219 if (current_unit->flags.pad == PAD_YES)
223 generate_error (ERROR_EOR, NULL);
232 /* write_block()-- Function for writing a block of bytes to the
233 * current file at the current position, advancing the file pointer.
234 * We are given a length and return a pointer to a buffer that the
235 * caller must (completely) fill in. Returns NULL on error. */
238 write_block (int length)
242 if (!is_internal_unit() && current_unit->bytes_left < length)
244 generate_error (ERROR_EOR, NULL);
248 current_unit->bytes_left -= length;
249 dest = salloc_w (current_unit->s, &length);
251 if (ioparm.size != NULL)
252 *ioparm.size += length;
258 /* unformatted_read()-- Master function for unformatted reads. */
261 unformatted_read (bt type, void *dest, int length)
266 source = read_block (&w);
270 memcpy (dest, source, w);
272 memset (((char *) dest) + w, ' ', length - w);
277 unformatted_write (bt type, void *source, int length)
280 dest = write_block (length);
282 memcpy (dest, source, length);
286 /* type_name()-- Return a pointer to the name of a type. */
311 internal_error ("type_name(): Bad type");
318 /* write_constant_string()-- write a constant string to the output.
319 * This is complicated because the string can have doubled delimiters
320 * in it. The length in the format node is the true length. */
323 write_constant_string (fnode * f)
325 char c, delimiter, *p, *q;
328 length = f->u.string.length;
332 p = write_block (length);
339 for (; length > 0; length--)
342 if (c == delimiter && c != 'H')
343 q++; /* Skip the doubled delimiter */
348 /* require_type()-- Given actual and expected types in a formatted
349 * data transfer, make sure they agree. If not, an error message is
350 * generated. Returns nonzero if something went wrong. */
353 require_type (bt expected, bt actual, fnode * f)
357 if (actual == expected)
360 st_sprintf (buffer, "Expected %s for item %d in formatted transfer, got %s",
361 type_name (expected), g.item_count, type_name (actual));
363 format_error (f, buffer);
368 /* formatted_transfer()-- This subroutine is the main loop for a
369 * formatted data transfer statement. It would be natural to
370 * implement this as a coroutine with the user program, but C makes
371 * that awkward. We loop, processesing format elements. When we
372 * actually have to transfer data instead of just setting flags, we
373 * return control to the user program which calls a subroutine that
374 * supplies the address and type of the next element, then comes back
375 * here to process it. */
378 formatted_transfer (bt type, void *p, int len)
383 int consume_data_flag;
385 /* Change a complex data item into a pair of reals */
387 n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2);
388 if (type == BT_COMPLEX)
391 /* If reversion has occurred and there is another real data item,
392 * then we have to move to the next record */
394 if (g.reversion_flag && n > 0)
396 g.reversion_flag = 0;
401 consume_data_flag = 1 ;
402 if (ioparm.library_return != LIBRARY_OK)
407 return; /* No data descriptors left (already raised) */
414 if (require_type (BT_INTEGER, type, f))
417 if (g.mode == READING)
418 read_decimal (f, p, len);
427 if (require_type (BT_INTEGER, type, f))
430 if (g.mode == READING)
431 read_radix (f, p, len, 2);
441 if (g.mode == READING)
442 read_radix (f, p, len, 8);
452 if (g.mode == READING)
453 read_radix (f, p, len, 16);
462 if (require_type (BT_CHARACTER, type, f))
465 if (g.mode == READING)
476 if (g.mode == READING)
486 if (require_type (BT_REAL, type, f))
489 if (g.mode == READING)
499 if (require_type (BT_REAL, type, f))
502 if (g.mode == READING)
511 if (require_type (BT_REAL, type, f))
514 if (g.mode == READING)
517 write_en (f, p, len);
524 if (require_type (BT_REAL, type, f))
527 if (g.mode == READING)
530 write_es (f, p, len);
537 if (require_type (BT_REAL, type, f))
540 if (g.mode == READING)
550 if (g.mode == READING)
554 read_decimal (f, p, len);
585 internal_error ("formatted_transfer(): Bad type");
591 consume_data_flag = 0 ;
592 if (g.mode == READING)
594 format_error (f, "Constant string in input format");
597 write_constant_string (f);
600 /* Format codes that don't transfer data */
603 consume_data_flag = 0 ;
604 if (g.mode == READING)
613 pos= current_unit->recl - current_unit->bytes_left - pos;
617 consume_data_flag = 0 ;
620 if (pos < 0 || pos >= current_unit->recl )
622 generate_error (ERROR_EOR, "T Or TL edit position error");
625 m = pos - (current_unit->recl - current_unit->bytes_left);
633 if (g.mode == READING)
640 move_pos_offset (current_unit->s,m);
646 consume_data_flag = 0 ;
647 g.sign_status = SIGN_S;
651 consume_data_flag = 0 ;
652 g.sign_status = SIGN_SS;
656 consume_data_flag = 0 ;
657 g.sign_status = SIGN_SP;
661 consume_data_flag = 0 ;
662 g.blank_status = BLANK_NULL;
666 consume_data_flag = 0 ;
667 g.blank_status = BLANK_ZERO;
671 consume_data_flag = 0 ;
672 g.scale_factor = f->u.k;
676 consume_data_flag = 0 ;
681 consume_data_flag = 0 ;
682 for (i = 0; i < f->repeat; i++)
688 /* A colon descriptor causes us to exit this loop (in particular
689 * preventing another / descriptor from being processed) unless there
690 * is another data item to be transferred. */
691 consume_data_flag = 0 ;
697 internal_error ("Bad format node");
700 /* Free a buffer that we had to allocate during a sequential
701 * formatted read of a block that was larger than the static
704 if (line_buffer != NULL)
706 free_mem (line_buffer);
710 /* Adjust the item count and data pointer */
712 if ((consume_data_flag > 0) && (n > 0))
715 p = ((char *) p) + len;
721 /* Come here when we need a data descriptor but don't have one. We
722 * push the current format node back onto the input, then return and
723 * let the user program call us back with the data. */
731 /* Data transfer entry points. The type of the data entity is
732 * implicit in the subroutine call. This prevents us from having to
733 * share a common enum with the compiler. */
736 transfer_integer (void *p, int kind)
740 if (ioparm.library_return != LIBRARY_OK)
742 transfer (BT_INTEGER, p, kind);
747 transfer_real (void *p, int kind)
751 if (ioparm.library_return != LIBRARY_OK)
753 transfer (BT_REAL, p, kind);
758 transfer_logical (void *p, int kind)
762 if (ioparm.library_return != LIBRARY_OK)
764 transfer (BT_LOGICAL, p, kind);
769 transfer_character (void *p, int len)
773 if (ioparm.library_return != LIBRARY_OK)
775 transfer (BT_CHARACTER, p, len);
780 transfer_complex (void *p, int kind)
784 if (ioparm.library_return != LIBRARY_OK)
786 transfer (BT_COMPLEX, p, kind);
790 /* us_read()-- Preposition a sequential unformatted file while reading. */
798 n = sizeof (offset_t);
799 p = (offset_t *) salloc_r (current_unit->s, &n);
801 if (p == NULL || n != sizeof (offset_t))
803 generate_error (ERROR_BAD_US, NULL);
807 current_unit->bytes_left = *p;
811 /* us_write()-- Preposition a sequential unformatted file while
812 * writing. This amount to writing a bogus length that will be filled
821 length = sizeof (offset_t);
822 p = (offset_t *) salloc_w (current_unit->s, &length);
826 generate_error (ERROR_OS, NULL);
830 *p = 0; /* Bogus value for now */
831 if (sfree (current_unit->s) == FAILURE)
832 generate_error (ERROR_OS, NULL);
834 current_unit->bytes_left = current_unit->recl;
838 /* pre_position()-- position to the next record prior to transfer. We
839 * are assumed to be before the next record. We also calculate the
840 * bytes in the next record. */
846 if (current_unit->current_record)
847 return; /* Already positioned */
849 switch (current_mode ())
851 case UNFORMATTED_SEQUENTIAL:
852 if (g.mode == READING)
859 case FORMATTED_SEQUENTIAL:
860 case FORMATTED_DIRECT:
861 case UNFORMATTED_DIRECT:
862 current_unit->bytes_left = current_unit->recl;
866 current_unit->current_record = 1;
870 /* data_transfer_init()-- Initialize things for a data transfer. This
871 * code is common for both reading and writing. */
874 data_transfer_init (int read_flag)
876 unit_flags u_flags; /* used for creating a unit if needed */
878 g.mode = read_flag ? READING : WRITING;
880 if (ioparm.size != NULL)
881 *ioparm.size = 0; /* Initialize the count */
883 current_unit = get_unit (read_flag);
884 if (current_unit == NULL)
885 { /* open the unit with some default flags */
886 memset (&u_flags, '\0', sizeof (u_flags));
887 u_flags.access = ACCESS_SEQUENTIAL;
888 u_flags.action = ACTION_READWRITE;
889 u_flags.form = FORM_UNSPECIFIED;
890 u_flags.delim = DELIM_UNSPECIFIED;
891 u_flags.blank = BLANK_UNSPECIFIED;
892 u_flags.pad = PAD_UNSPECIFIED;
893 u_flags.status = STATUS_UNKNOWN;
895 current_unit = get_unit (read_flag);
898 if (current_unit == NULL)
901 if (is_internal_unit() && g.mode==WRITING)
902 empty_internal_buffer (current_unit->s);
904 /* Check the action */
906 if (read_flag && current_unit->flags.action == ACTION_WRITE)
907 generate_error (ERROR_BAD_ACTION,
908 "Cannot read from file opened for WRITE");
910 if (!read_flag && current_unit->flags.action == ACTION_READ)
911 generate_error (ERROR_BAD_ACTION, "Cannot write to file opened for READ");
913 if (ioparm.library_return != LIBRARY_OK)
916 /* Check the format */
921 if (ioparm.library_return != LIBRARY_OK)
924 if (current_unit->flags.form == FORM_UNFORMATTED
925 && (ioparm.format != NULL || ioparm.list_format))
926 generate_error (ERROR_OPTION_CONFLICT,
927 "Format present for UNFORMATTED data transfer");
929 if (ioparm.namelist_name != NULL && ionml != NULL)
931 if(ioparm.format != NULL)
932 generate_error (ERROR_OPTION_CONFLICT,
933 "A format cannot be specified with a namelist");
935 else if (current_unit->flags.form == FORM_FORMATTED &&
936 ioparm.format == NULL && !ioparm.list_format)
937 generate_error (ERROR_OPTION_CONFLICT,
938 "Missing format for FORMATTED data transfer");
941 if (is_internal_unit () && current_unit->flags.form == FORM_UNFORMATTED)
942 generate_error (ERROR_OPTION_CONFLICT,
943 "Internal file cannot be accessed by UNFORMATTED data transfer");
945 /* Check the record number */
947 if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == 0)
949 generate_error (ERROR_MISSING_OPTION,
950 "Direct access data transfer requires record number");
954 if (current_unit->flags.access == ACCESS_SEQUENTIAL && ioparm.rec != 0)
956 generate_error (ERROR_OPTION_CONFLICT,
957 "Record number not allowed for sequential access data transfer");
961 /* Process the ADVANCE option */
963 advance_status = (ioparm.advance == NULL) ? ADVANCE_UNSPECIFIED :
964 find_option (ioparm.advance, ioparm.advance_len, advance_opt,
965 "Bad ADVANCE parameter in data transfer statement");
967 if (advance_status != ADVANCE_UNSPECIFIED)
969 if (current_unit->flags.access == ACCESS_DIRECT)
970 generate_error (ERROR_OPTION_CONFLICT,
971 "ADVANCE specification conflicts with sequential access");
973 if (is_internal_unit ())
974 generate_error (ERROR_OPTION_CONFLICT,
975 "ADVANCE specification conflicts with internal file");
977 if (ioparm.format == NULL || ioparm.list_format)
978 generate_error (ERROR_OPTION_CONFLICT,
979 "ADVANCE specification requires an explicit format");
984 if (ioparm.eor != 0 && advance_status == ADVANCE_NO)
985 generate_error (ERROR_MISSING_OPTION,
986 "EOR specification requires an ADVANCE specification of NO");
988 if (ioparm.size != NULL && advance_status != ADVANCE_NO)
989 generate_error (ERROR_MISSING_OPTION,
990 "SIZE specification requires an ADVANCE specification of NO");
994 { /* Write constraints */
997 generate_error (ERROR_OPTION_CONFLICT,
998 "END specification cannot appear in a write statement");
1000 if (ioparm.eor != 0)
1001 generate_error (ERROR_OPTION_CONFLICT,
1002 "EOR specification cannot appear in a write statement");
1004 if (ioparm.size != 0)
1005 generate_error (ERROR_OPTION_CONFLICT,
1006 "SIZE specification cannot appear in a write statement");
1009 if (advance_status == ADVANCE_UNSPECIFIED)
1010 advance_status = ADVANCE_YES;
1011 if (ioparm.library_return != LIBRARY_OK)
1014 /* Sanity checks on the record number */
1018 if (ioparm.rec <= 0)
1020 generate_error (ERROR_BAD_OPTION, "Record number must be positive");
1024 if (ioparm.rec >= current_unit->maxrec)
1026 generate_error (ERROR_BAD_OPTION, "Record number too large");
1030 /* Position the file */
1032 if (sseek (current_unit->s,
1033 (ioparm.rec - 1) * current_unit->recl) == FAILURE)
1034 generate_error (ERROR_OS, NULL);
1037 /* Set the initial value of flags */
1039 g.blank_status = current_unit->flags.blank;
1040 g.sign_status = SIGN_S;
1048 /* Set up the subroutine that will handle the transfers */
1052 if (current_unit->flags.form == FORM_UNFORMATTED)
1053 transfer = unformatted_read;
1056 if (ioparm.list_format)
1058 transfer = list_formatted_read;
1062 transfer = formatted_transfer;
1067 if (current_unit->flags.form == FORM_UNFORMATTED)
1068 transfer = unformatted_write;
1071 if (ioparm.list_format)
1072 transfer = list_formatted_write;
1074 transfer = formatted_transfer;
1078 /* Make sure that we don't do a read after a nonadvancing write */
1082 if (current_unit->read_bad)
1084 generate_error (ERROR_BAD_OPTION,
1085 "Cannot READ after a nonadvancing WRITE");
1091 if (advance_status == ADVANCE_YES)
1092 current_unit->read_bad = 1;
1095 /* Start the data transfer if we are doing a formatted transfer */
1096 if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format
1097 && ioparm.namelist_name == NULL && ionml == NULL)
1099 formatted_transfer (0, NULL, 0);
1104 /* next_record_r()-- Space to the next record for read mode. If the
1105 * file is not seekable, we read MAX_READ chunks until we get to the
1106 * right position. */
1108 #define MAX_READ 4096
1111 next_record_r (int done)
1113 int rlength, length;
1117 switch (current_mode ())
1119 case UNFORMATTED_SEQUENTIAL:
1120 current_unit->bytes_left += sizeof (offset_t); /* Skip over tail */
1124 case FORMATTED_DIRECT:
1125 case UNFORMATTED_DIRECT:
1126 if (current_unit->bytes_left == 0)
1129 if (is_seekable (current_unit->s))
1131 new = file_position (current_unit->s) + current_unit->bytes_left;
1133 /* Direct access files do not generate END conditions, only I/O errors */
1135 if (sseek (current_unit->s, new) == FAILURE)
1136 generate_error (ERROR_OS, NULL);
1140 { /* Seek by reading data */
1141 while (current_unit->bytes_left > 0)
1143 rlength = length = (MAX_READ > current_unit->bytes_left) ?
1144 MAX_READ : current_unit->bytes_left;
1146 p = salloc_r (current_unit->s, &rlength);
1149 generate_error (ERROR_OS, NULL);
1153 current_unit->bytes_left -= length;
1159 case FORMATTED_SEQUENTIAL:
1161 if (sf_seen_eor && done)
1166 p = salloc_r (current_unit->s, &length);
1168 /*In case of internal file, there may not be any '\n'.*/
1169 if (is_internal_unit() && p == NULL)
1176 generate_error (ERROR_OS, NULL);
1182 current_unit->endfile = AT_ENDFILE;
1191 if (current_unit->flags.access == ACCESS_SEQUENTIAL)
1192 test_endfile (current_unit);
1196 /* next_record_w()-- Position to the next record in write mode */
1199 next_record_w (int done)
1205 switch (current_mode ())
1207 case FORMATTED_DIRECT:
1208 case UNFORMATTED_DIRECT:
1209 if (current_unit->bytes_left == 0)
1212 length = current_unit->bytes_left;
1214 p = salloc_w (current_unit->s, &length);
1218 memset (p, ' ', current_unit->bytes_left);
1219 if (sfree (current_unit->s) == FAILURE)
1224 case UNFORMATTED_SEQUENTIAL:
1225 m = current_unit->recl - current_unit->bytes_left; /* Bytes written */
1226 c = file_position (current_unit->s);
1228 length = sizeof (offset_t);
1230 /* Write the length tail */
1232 p = salloc_w (current_unit->s, &length);
1236 *((offset_t *) p) = m;
1237 if (sfree (current_unit->s) == FAILURE)
1240 /* Seek to the head and overwrite the bogus length with the real length */
1242 p = salloc_w_at (current_unit->s, &length, c - m - length);
1244 generate_error (ERROR_OS, NULL);
1246 *((offset_t *) p) = m;
1247 if (sfree (current_unit->s) == FAILURE)
1250 /* Seek past the end of the current record */
1252 if (sseek (current_unit->s, c + sizeof (offset_t)) == FAILURE)
1257 case FORMATTED_SEQUENTIAL:
1259 p = salloc_w (current_unit->s, &length);
1261 if (!is_internal_unit())
1264 *p = '\n'; /* no CR for internal writes */
1269 if (sfree (current_unit->s) == FAILURE)
1275 generate_error (ERROR_OS, NULL);
1281 /* next_record()-- Position to the next record, which means moving to
1282 * the end of the current record. This can happen under several
1283 * different conditions. If the done flag is not set, we get ready to
1284 * process the next record. */
1287 next_record (int done)
1290 current_unit->read_bad = 0;
1292 if (g.mode == READING)
1293 next_record_r (done);
1295 next_record_w (done);
1297 current_unit->current_record = 0;
1298 if (current_unit->flags.access == ACCESS_DIRECT)
1299 current_unit->last_record = file_position (current_unit->s)
1300 / current_unit->recl;
1302 current_unit->last_record++;
1309 /* Finalize the current data transfer. For a nonadvancing transfer,
1310 * this means advancing to the next record. */
1313 finalize_transfer (void)
1316 if (setjmp (g.eof_jump))
1318 generate_error (ERROR_END, NULL);
1322 if ((ionml != NULL) && (ioparm.namelist_name != NULL))
1324 if (ioparm.namelist_read_mode)
1331 if (current_unit == NULL)
1334 if (ioparm.list_format && g.mode == READING)
1335 finish_list_read ();
1340 if (advance_status == ADVANCE_NO)
1343 current_unit->current_record = 0;
1346 sfree (current_unit->s);
1350 /* The READ statement */
1358 data_transfer_init (1);
1360 /* Handle complications dealing with the endfile record. It is
1361 * significant that this is the only place where ERROR_END is
1362 * generated. Reading an end of file elsewhere is either end of
1363 * record or an I/O error. */
1365 if (current_unit->flags.access == ACCESS_SEQUENTIAL)
1366 switch (current_unit->endfile)
1372 if (!is_internal_unit())
1374 generate_error (ERROR_END, NULL);
1375 current_unit->endfile = AFTER_ENDFILE;
1380 generate_error (ERROR_ENDFILE, NULL);
1389 finalize_transfer ();
1400 data_transfer_init (0);
1405 st_write_done (void)
1408 finalize_transfer ();
1410 /* Deal with endfile conditions associated with sequential files */
1412 if (current_unit != NULL && current_unit->flags.access == ACCESS_SEQUENTIAL)
1413 switch (current_unit->endfile)
1415 case AT_ENDFILE: /* Remain at the endfile record */
1419 current_unit->endfile = AT_ENDFILE; /* Just at it now */
1422 case NO_ENDFILE: /* Get rid of whatever is after this record */
1423 if (struncate (current_unit->s) == FAILURE)
1424 generate_error (ERROR_OS, NULL);
1426 current_unit->endfile = AT_ENDFILE;
1435 st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
1438 namelist_info *t1 = NULL, *t2 = NULL;
1439 namelist_info *nml = (namelist_info *) get_mem (sizeof(
1441 nml->mem_pos = var_addr;
1442 nml->var_name = (char*) get_mem (var_name_len+1);
1443 strncpy (nml->var_name,var_name,var_name_len);
1444 nml->var_name[var_name_len] = 0;
1465 st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len,
1468 st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER);
1472 st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len,
1475 st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL);
1479 st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len,
1482 st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER);
1486 st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len,
1489 st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX);
1493 st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len,
1496 st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL);