Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
R
riscv-gcc-1
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
lvzhengyang
riscv-gcc-1
Commits
c86af7f3
Commit
c86af7f3
authored
Nov 02, 2010
by
Janne Blomqvist
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
PR 45629 Remove usage of setjmp/longjmp
From-SVN: r166180
parent
6f1abb06
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
274 additions
and
179 deletions
+274
-179
libgfortran/ChangeLog
+29
-0
libgfortran/io/io.h
+4
-3
libgfortran/io/list_read.c
+237
-167
libgfortran/io/transfer.c
+4
-9
No files found.
libgfortran/ChangeLog
View file @
c86af7f3
2010-11-02 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/45629
* io/io.h: Remove setjmp.h include.
(st_parameter_dt): Change last_char to int, remove eof_jump.
* io/list_read.c (next_char): Return EOF instead of jumping.
(unget_char): Use int to be able to handle EOF.
(eat_spaces): Handle EOF return from next_char.
(eat_line): Likewise.
(eat_separator): Handle EOF return from next_char, eat_spaces,
eat_line.
(finish_separator): Likewise.
(convert_integer): Likewise.
(read_logical): Likewise.
(read_integer): Likewise.
(read_character): Likewise.
(parse_real): Likewise.
(read_complex): Likewise.
(read_real): Likewise.
(list_formatted_read_scalar): Likewise.
(list_formatted_read): Likewise.
(finish_list_read): Likewise.
(nml_parse_qualifier): Likewise.
(nml_match_name): Likewise.
(nml_get_obj_data): Likewise.
(namelist_read): Likewise.
* io/transfer.c (data_transfer_init): Initialize last_char.
(finalize_transfer): Remove jmp_buf setup.
2010-10-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/46010
...
...
libgfortran/io/io.h
View file @
c86af7f3
...
...
@@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
#include <setjmp.h>
#include <gthr.h>
/* Forward declarations. */
...
...
@@ -427,7 +426,10 @@ typedef struct st_parameter_dt
unsigned
format_not_saved
:
1
;
/* 14 unused bits. */
char
last_char
;
/* Used for ungetc() style functionality. Possible values
are an unsigned char, EOF, or EOF - 1 used to mark the
field as not valid. */
int
last_char
;
char
nml_delim
;
int
repeat_count
;
...
...
@@ -438,7 +440,6 @@ typedef struct st_parameter_dt
char
*
scratch
;
char
*
line_buffer
;
struct
format_data
*
fmt
;
jmp_buf
*
eof_jump
;
namelist_info
*
ionml
;
/* A flag used to identify when a non-standard expanded namelist read
has occurred. */
...
...
libgfortran/io/list_read.c
View file @
c86af7f3
...
...
@@ -133,19 +133,18 @@ free_line (st_parameter_dt *dtp)
}
static
char
static
int
next_char
(
st_parameter_dt
*
dtp
)
{
ssize_t
length
;
gfc_offset
record
;
char
c
;
int
cc
;
int
c
;
if
(
dtp
->
u
.
p
.
last_char
!=
'\0'
)
if
(
dtp
->
u
.
p
.
last_char
!=
EOF
-
1
)
{
dtp
->
u
.
p
.
at_eol
=
0
;
c
=
dtp
->
u
.
p
.
last_char
;
dtp
->
u
.
p
.
last_char
=
'\0'
;
dtp
->
u
.
p
.
last_char
=
EOF
-
1
;
goto
done
;
}
...
...
@@ -172,7 +171,7 @@ next_char (st_parameter_dt *dtp)
if
(
is_array_io
(
dtp
))
{
if
(
dtp
->
u
.
p
.
at_eof
)
longjmp
(
*
dtp
->
u
.
p
.
eof_jump
,
1
)
;
return
EOF
;
/* Check for "end-of-record" condition. */
if
(
dtp
->
u
.
p
.
current_unit
->
bytes_left
==
0
)
...
...
@@ -192,7 +191,7 @@ next_char (st_parameter_dt *dtp)
record
*=
dtp
->
u
.
p
.
current_unit
->
recl
;
if
(
sseek
(
dtp
->
u
.
p
.
current_unit
->
s
,
record
,
SEEK_SET
)
<
0
)
longjmp
(
*
dtp
->
u
.
p
.
eof_jump
,
1
)
;
return
EOF
;
dtp
->
u
.
p
.
current_unit
->
bytes_left
=
dtp
->
u
.
p
.
current_unit
->
recl
;
goto
done
;
...
...
@@ -203,7 +202,9 @@ next_char (st_parameter_dt *dtp)
if
(
is_internal_unit
(
dtp
))
{
length
=
sread
(
dtp
->
u
.
p
.
current_unit
->
s
,
&
c
,
1
);
char
cc
;
length
=
sread
(
dtp
->
u
.
p
.
current_unit
->
s
,
&
cc
,
1
);
c
=
cc
;
if
(
length
<
0
)
{
generate_error
(
&
dtp
->
common
,
LIBERROR_OS
,
NULL
);
...
...
@@ -223,7 +224,7 @@ next_char (st_parameter_dt *dtp)
else
{
if
(
dtp
->
u
.
p
.
at_eof
)
longjmp
(
*
dtp
->
u
.
p
.
eof_jump
,
1
)
;
return
EOF
;
if
(
length
==
0
)
{
c
=
'\n'
;
...
...
@@ -233,23 +234,12 @@ next_char (st_parameter_dt *dtp)
}
else
{
cc
=
fbuf_getc
(
dtp
->
u
.
p
.
current_unit
);
if
(
cc
==
EOF
)
{
if
(
dtp
->
u
.
p
.
current_unit
->
endfile
==
AT_ENDFILE
)
longjmp
(
*
dtp
->
u
.
p
.
eof_jump
,
1
);
dtp
->
u
.
p
.
current_unit
->
endfile
=
AT_ENDFILE
;
c
=
'\n'
;
}
else
c
=
(
char
)
cc
;
if
(
is_stream_io
(
dtp
)
&&
cc
!=
EOF
)
c
=
fbuf_getc
(
dtp
->
u
.
p
.
current_unit
);
if
(
c
!=
EOF
&&
is_stream_io
(
dtp
))
dtp
->
u
.
p
.
current_unit
->
strm_pos
++
;
}
done:
dtp
->
u
.
p
.
at_eol
=
(
c
==
'\n'
||
c
==
'\r'
);
dtp
->
u
.
p
.
at_eol
=
(
c
==
'\n'
||
c
==
'\r'
||
c
==
EOF
);
return
c
;
}
...
...
@@ -257,7 +247,7 @@ done:
/* Push a character back onto the input. */
static
void
unget_char
(
st_parameter_dt
*
dtp
,
char
c
)
unget_char
(
st_parameter_dt
*
dtp
,
int
c
)
{
dtp
->
u
.
p
.
last_char
=
c
;
}
...
...
@@ -266,33 +256,35 @@ unget_char (st_parameter_dt *dtp, char c)
/* Skip over spaces in the input. Returns the nonspace character that
terminated the eating and also places it back on the input. */
static
char
static
int
eat_spaces
(
st_parameter_dt
*
dtp
)
{
char
c
;
int
c
;
do
{
c
=
next_char
(
dtp
);
}
while
(
c
==
' '
||
c
==
'\t'
);
c
=
next_char
(
dtp
);
while
(
c
!=
EOF
&&
(
c
==
' '
||
c
==
'\t'
));
unget_char
(
dtp
,
c
);
return
c
;
}
/* This function reads characters through to the end of the current line and
just ignores them. */
/* This function reads characters through to the end of the current
line and just ignores them. Returns 0 for success and LIBERROR_END
if it hit EOF. */
static
void
static
int
eat_line
(
st_parameter_dt
*
dtp
)
{
char
c
;
int
c
;
do
c
=
next_char
(
dtp
);
while
(
c
!=
'\n'
);
while
(
c
!=
EOF
&&
c
!=
'\n'
);
if
(
c
==
EOF
)
return
LIBERROR_END
;
return
0
;
}
...
...
@@ -305,17 +297,21 @@ eat_line (st_parameter_dt *dtp)
separator, we stop reading. If there are more input items, we
continue reading the separator with finish_separator() which takes
care of the fact that we may or may not have seen a comma as part
of the separator.
*/
of the separator.
static
void
Returns 0 for success, and non-zero error code otherwise. */
static
int
eat_separator
(
st_parameter_dt
*
dtp
)
{
char
c
,
n
;
int
c
,
n
;
int
err
=
0
;
eat_spaces
(
dtp
);
dtp
->
u
.
p
.
comma_flag
=
0
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
switch
(
c
)
{
case
','
:
...
...
@@ -336,7 +332,8 @@ eat_separator (st_parameter_dt *dtp)
case
'\r'
:
dtp
->
u
.
p
.
at_eol
=
1
;
n
=
next_char
(
dtp
);
if
((
n
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
if
(
n
!=
'\n'
)
{
unget_char
(
dtp
,
n
);
...
...
@@ -349,15 +346,22 @@ eat_separator (st_parameter_dt *dtp)
{
do
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
if
(
c
==
'!'
)
{
eat_line
(
dtp
);
c
=
next_char
(
dtp
);
err
=
eat_line
(
dtp
);
if
(
err
)
return
err
;
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
if
(
c
==
'!'
)
{
eat_line
(
dtp
);
c
=
next_char
(
dtp
);
err
=
eat_line
(
dtp
);
if
(
err
)
return
err
;
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
}
}
}
...
...
@@ -369,9 +373,9 @@ eat_separator (st_parameter_dt *dtp)
case
'!'
:
if
(
dtp
->
u
.
p
.
namelist_mode
)
{
/* Eat a namelist comment. */
do
c
=
next_char
(
dtp
);
while
(
c
!=
'\n'
)
;
err
=
eat_line
(
dtp
);
if
(
err
)
return
err
;
break
;
}
...
...
@@ -382,22 +386,26 @@ eat_separator (st_parameter_dt *dtp)
unget_char
(
dtp
,
c
);
break
;
}
return
err
;
}
/* Finish processing a separator that was interrupted by a newline.
If we're here, then another data item is present, so we finish what
we started on the previous line. */
we started on the previous line. Return 0 on success, error code
on failure. */
static
void
static
int
finish_separator
(
st_parameter_dt
*
dtp
)
{
char
c
;
int
c
;
int
err
;
restart:
eat_spaces
(
dtp
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
switch
(
c
)
{
case
','
:
...
...
@@ -405,7 +413,8 @@ finish_separator (st_parameter_dt *dtp)
unget_char
(
dtp
,
c
);
else
{
c
=
eat_spaces
(
dtp
);
if
((
c
=
eat_spaces
(
dtp
))
==
EOF
)
return
LIBERROR_END
;
if
(
c
==
'\n'
||
c
==
'\r'
)
goto
restart
;
}
...
...
@@ -415,7 +424,7 @@ finish_separator (st_parameter_dt *dtp)
case
'/'
:
dtp
->
u
.
p
.
input_complete
=
1
;
if
(
!
dtp
->
u
.
p
.
namelist_mode
)
return
;
return
err
;
break
;
case
'\n'
:
...
...
@@ -425,10 +434,9 @@ finish_separator (st_parameter_dt *dtp)
case
'!'
:
if
(
dtp
->
u
.
p
.
namelist_mode
)
{
do
c
=
next_char
(
dtp
);
while
(
c
!=
'\n'
);
err
=
eat_line
(
dtp
);
if
(
err
)
return
err
;
goto
restart
;
}
...
...
@@ -436,6 +444,7 @@ finish_separator (st_parameter_dt *dtp)
unget_char
(
dtp
,
c
);
break
;
}
return
err
;
}
...
...
@@ -535,10 +544,11 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
static
int
parse_repeat
(
st_parameter_dt
*
dtp
)
{
char
c
,
message
[
100
];
int
repeat
;
char
message
[
100
];
int
c
,
repeat
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_repeat
;
switch
(
c
)
{
CASE_DIGITS:
...
...
@@ -599,8 +609,14 @@ parse_repeat (st_parameter_dt *dtp)
bad_repeat:
eat_line
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
1
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad repeat count in item %d of list input"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -631,8 +647,8 @@ l_push_char (st_parameter_dt *dtp, char c)
static
void
read_logical
(
st_parameter_dt
*
dtp
,
int
length
)
{
char
c
,
message
[
100
];
int
i
,
v
;
char
message
[
100
];
int
c
,
i
,
v
;
if
(
parse_repeat
(
dtp
))
return
;
...
...
@@ -643,7 +659,8 @@ read_logical (st_parameter_dt *dtp, int length)
{
case
't'
:
v
=
1
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_logical
;
l_push_char
(
dtp
,
c
);
if
(
!
is_separator
(
c
))
...
...
@@ -653,7 +670,8 @@ read_logical (st_parameter_dt *dtp, int length)
break
;
case
'f'
:
v
=
0
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_logical
;
l_push_char
(
dtp
,
c
);
if
(
!
is_separator
(
c
))
...
...
@@ -695,10 +713,8 @@ read_logical (st_parameter_dt *dtp, int length)
/* Eat trailing garbage. */
do
{
c
=
next_char
(
dtp
);
}
while
(
!
is_separator
(
c
));
c
=
next_char
(
dtp
);
while
(
c
!=
EOF
&&
!
is_separator
(
c
));
unget_char
(
dtp
,
c
);
eat_separator
(
dtp
);
...
...
@@ -746,8 +762,14 @@ read_logical (st_parameter_dt *dtp, int length)
if
(
nml_bad_return
(
dtp
,
c
))
return
;
eat_line
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad logical value while reading item %d"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -771,8 +793,8 @@ read_logical (st_parameter_dt *dtp, int length)
static
void
read_integer
(
st_parameter_dt
*
dtp
,
int
length
)
{
char
c
,
message
[
100
];
int
negative
;
char
message
[
100
];
int
c
,
negative
;
negative
=
0
;
...
...
@@ -784,7 +806,8 @@ read_integer (st_parameter_dt *dtp, int length)
/* Fall through... */
case
'+'
:
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_integer
;
goto
get_integer
;
CASE_SEPARATORS:
/* Single null. */
...
...
@@ -829,7 +852,8 @@ read_integer (st_parameter_dt *dtp, int length)
/* Get the real integer. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_integer
;
switch
(
c
)
{
CASE_DIGITS:
...
...
@@ -875,9 +899,15 @@ read_integer (st_parameter_dt *dtp, int length)
if
(
nml_bad_return
(
dtp
,
c
))
return
;
eat_line
(
dtp
);
free_saved
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad integer for item %d in list input"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -905,11 +935,13 @@ read_integer (st_parameter_dt *dtp, int length)
static
void
read_character
(
st_parameter_dt
*
dtp
,
int
length
__attribute__
((
unused
)))
{
char
c
,
quote
,
message
[
100
];
char
quote
,
message
[
100
];
int
c
;
quote
=
' '
;
/* Space means no quote character. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
eof
;
switch
(
c
)
{
CASE_DIGITS:
...
...
@@ -941,7 +973,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
for
(;;)
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
eof
;
switch
(
c
)
{
CASE_DIGITS:
...
...
@@ -968,7 +1001,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
/* Now get the real string. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
eof
;
switch
(
c
)
{
CASE_SEPARATORS:
...
...
@@ -989,7 +1023,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
get_string:
for
(;;)
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
eof
;
switch
(
c
)
{
case
'"'
:
...
...
@@ -1003,7 +1038,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
/* See if we have a doubled quote character or the end of
the string. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
eof
;
if
(
c
==
quote
)
{
push_char
(
dtp
,
quote
);
...
...
@@ -1034,6 +1070,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
invalid. */
done:
c
=
next_char
(
dtp
);
eof:
if
(
is_separator
(
c
)
||
c
==
'!'
)
{
unget_char
(
dtp
,
c
);
...
...
@@ -1044,6 +1081,11 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
else
{
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
;
}
sprintf
(
message
,
"Invalid string input in item %d"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -1057,14 +1099,16 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
static
int
parse_real
(
st_parameter_dt
*
dtp
,
void
*
buffer
,
int
length
)
{
char
c
,
message
[
100
];
int
m
,
seen_dp
;
char
message
[
100
];
int
c
,
m
,
seen_dp
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
if
(
c
==
'-'
||
c
==
'+'
)
{
push_char
(
dtp
,
c
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
}
if
(
c
==
','
&&
dtp
->
u
.
p
.
current_unit
->
decimal_status
==
DECIMAL_COMMA
)
...
...
@@ -1084,7 +1128,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
for
(;;)
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
if
(
c
==
','
&&
dtp
->
u
.
p
.
current_unit
->
decimal_status
==
DECIMAL_COMMA
)
c
=
'.'
;
switch
(
c
)
...
...
@@ -1112,7 +1157,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
case
'+'
:
push_char
(
dtp
,
'e'
);
push_char
(
dtp
,
c
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
goto
exp2
;
CASE_SEPARATORS:
...
...
@@ -1125,7 +1171,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
}
exp1:
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
if
(
c
!=
'-'
&&
c
!=
'+'
)
push_char
(
dtp
,
'+'
);
else
...
...
@@ -1142,7 +1189,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
for
(;;)
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad
;
switch
(
c
)
{
CASE_DIGITS:
...
...
@@ -1219,8 +1267,14 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
if
(
nml_bad_return
(
dtp
,
c
))
return
0
;
eat_line
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
1
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad floating point number for item %d"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -1236,7 +1290,7 @@ static void
read_complex
(
st_parameter_dt
*
dtp
,
void
*
dest
,
int
kind
,
size_t
size
)
{
char
message
[
100
];
char
c
;
int
c
;
if
(
parse_repeat
(
dtp
))
return
;
...
...
@@ -1303,8 +1357,14 @@ eol_2:
if
(
nml_bad_return
(
dtp
,
c
))
return
;
eat_line
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad complex value in item %d of list input"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -1316,7 +1376,8 @@ eol_2:
static
void
read_real
(
st_parameter_dt
*
dtp
,
void
*
dest
,
int
length
)
{
char
c
,
message
[
100
];
char
message
[
100
];
int
c
;
int
seen_dp
;
int
is_inf
;
...
...
@@ -1409,7 +1470,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
/* Now get the number itself. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_real
;
if
(
is_separator
(
c
))
{
/* Repeated null value. */
unget_char
(
dtp
,
c
);
...
...
@@ -1423,7 +1485,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
{
got_sign:
push_char
(
dtp
,
c
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_real
;
}
if
(
c
==
','
&&
dtp
->
u
.
p
.
current_unit
->
decimal_status
==
DECIMAL_COMMA
)
...
...
@@ -1460,6 +1523,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
break
;
CASE_SEPARATORS:
case
EOF
:
goto
done
;
case
'.'
:
...
...
@@ -1491,7 +1555,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
exp1:
push_char
(
dtp
,
'e'
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_real
;
if
(
c
!=
'+'
&&
c
!=
'-'
)
push_char
(
dtp
,
'+'
);
else
...
...
@@ -1612,7 +1677,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
if
(
c
==
' '
||
c
==
'\n'
||
c
==
'\r'
)
{
do
c
=
next_char
(
dtp
);
{
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
bad_real
;
}
while
(
c
==
' '
||
c
==
'\n'
||
c
==
'\r'
);
l_push_char
(
dtp
,
c
);
...
...
@@ -1652,8 +1720,14 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
if
(
nml_bad_return
(
dtp
,
c
))
return
;
eat_line
(
dtp
);
free_saved
(
dtp
);
if
(
c
==
EOF
)
{
hit_eof
(
dtp
);
return
;
}
else
eat_line
(
dtp
);
sprintf
(
message
,
"Bad real number in item %d of list input"
,
dtp
->
u
.
p
.
item_count
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
message
);
...
...
@@ -1700,29 +1774,16 @@ check_type (st_parameter_dt *dtp, bt type, int len)
reading, usually in the dtp->u.p.value[] array. If a repeat count is
greater than one, we copy the data item multiple times. */
static
void
list_formatted_read_scalar
(
st_parameter_dt
*
dtp
,
volatile
bt
type
,
void
*
p
,
static
int
list_formatted_read_scalar
(
st_parameter_dt
*
dtp
,
bt
type
,
void
*
p
,
int
kind
,
size_t
size
)
{
char
c
;
gfc_char4_t
*
q
;
int
i
,
m
;
jmp_buf
eof_jump
;
int
c
,
i
,
m
;
int
err
=
0
;
dtp
->
u
.
p
.
namelist_mode
=
0
;
dtp
->
u
.
p
.
eof_jump
=
&
eof_jump
;
if
(
setjmp
(
eof_jump
))
{
generate_error
(
&
dtp
->
common
,
LIBERROR_END
,
NULL
);
if
(
!
is_internal_unit
(
dtp
))
{
dtp
->
u
.
p
.
current_unit
->
endfile
=
AFTER_ENDFILE
;
dtp
->
u
.
p
.
current_unit
->
current_record
=
0
;
}
goto
cleanup
;
}
if
(
dtp
->
u
.
p
.
first_item
)
{
dtp
->
u
.
p
.
first_item
=
0
;
...
...
@@ -1730,7 +1791,11 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
dtp
->
u
.
p
.
repeat_count
=
1
;
dtp
->
u
.
p
.
at_eol
=
0
;
c
=
eat_spaces
(
dtp
);
if
((
c
=
eat_spaces
(
dtp
))
==
EOF
)
{
err
=
LIBERROR_END
;
goto
cleanup
;
}
if
(
is_separator
(
c
))
{
/* Found a null value. */
...
...
@@ -1754,7 +1819,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
if
(
dtp
->
u
.
p
.
repeat_count
>
0
)
{
if
(
check_type
(
dtp
,
type
,
kind
))
return
;
return
err
;
goto
set_value
;
}
...
...
@@ -1864,7 +1929,9 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
free_saved
(
dtp
);
cleanup:
dtp
->
u
.
p
.
eof_jump
=
NULL
;
if
(
err
==
LIBERROR_END
)
hit_eof
(
dtp
);
return
err
;
}
...
...
@@ -1876,6 +1943,7 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
char
*
tmp
;
size_t
stride
=
type
==
BT_CHARACTER
?
size
*
GFC_SIZE_OF_CHAR_KIND
(
kind
)
:
size
;
int
err
;
tmp
=
(
char
*
)
p
;
...
...
@@ -1883,7 +1951,10 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
for
(
elem
=
0
;
elem
<
nelems
;
elem
++
)
{
dtp
->
u
.
p
.
item_count
++
;
list_formatted_read_scalar
(
dtp
,
type
,
tmp
+
stride
*
elem
,
kind
,
size
);
err
=
list_formatted_read_scalar
(
dtp
,
type
,
tmp
+
stride
*
elem
,
kind
,
size
);
if
(
err
)
break
;
}
}
...
...
@@ -1893,7 +1964,7 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
void
finish_list_read
(
st_parameter_dt
*
dtp
)
{
char
c
;
int
err
;
free_saved
(
dtp
);
...
...
@@ -1905,18 +1976,9 @@ finish_list_read (st_parameter_dt *dtp)
return
;
}
do
{
c
=
next_char
(
dtp
);
}
while
(
c
!=
'\n'
);
if
(
dtp
->
u
.
p
.
current_unit
->
endfile
!=
NO_ENDFILE
)
{
generate_error
(
&
dtp
->
common
,
LIBERROR_END
,
NULL
);
dtp
->
u
.
p
.
current_unit
->
endfile
=
AFTER_ENDFILE
;
dtp
->
u
.
p
.
current_unit
->
current_record
=
0
;
}
err
=
eat_line
(
dtp
);
if
(
err
==
LIBERROR_END
)
hit_eof
(
dtp
);
}
/* NAMELIST INPUT
...
...
@@ -1953,7 +2015,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
int
neg
;
int
null_flag
;
int
is_array_section
,
is_char
;
char
c
;
int
c
;
is_char
=
0
;
is_array_section
=
0
;
...
...
@@ -1968,7 +2030,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
/* The next character in the stream should be the '('. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
/* Process the qualifier, by dimension and triplet. */
...
...
@@ -1981,7 +2044,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
neg
=
0
;
/* Process a potential sign. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
switch
(
c
)
{
case
'-'
:
...
...
@@ -1999,7 +2063,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
/* Process characters up to the next ':' , ',' or ')'. */
for
(;;)
{
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
switch
(
c
)
{
...
...
@@ -2025,7 +2090,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
case
' '
:
case
'\t'
:
eat_spaces
(
dtp
);
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
)
==
EOF
))
return
FAILURE
;
break
;
default:
...
...
@@ -2229,12 +2295,13 @@ static void
nml_match_name
(
st_parameter_dt
*
dtp
,
const
char
*
name
,
index_type
len
)
{
index_type
i
;
char
c
;
int
c
;
dtp
->
u
.
p
.
nml_read_error
=
0
;
for
(
i
=
0
;
i
<
len
;
i
++
)
{
c
=
next_char
(
dtp
);
if
(
tolower
(
c
)
!=
tolower
(
name
[
i
]
))
if
(
c
==
EOF
||
(
tolower
(
c
)
!=
tolower
(
name
[
i
])
))
{
dtp
->
u
.
p
.
nml_read_error
=
1
;
break
;
...
...
@@ -2591,7 +2658,7 @@ static try
nml_get_obj_data
(
st_parameter_dt
*
dtp
,
namelist_info
**
pprev_nl
,
char
*
nml_err_msg
,
size_t
nml_err_msg_size
)
{
char
c
;
int
c
;
namelist_info
*
nl
;
namelist_info
*
first_nl
=
NULL
;
namelist_info
*
root_nl
=
NULL
;
...
...
@@ -2612,11 +2679,13 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
if
(
dtp
->
u
.
p
.
input_complete
)
return
SUCCESS
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
switch
(
c
)
{
case
'='
:
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
if
(
c
!=
'?'
)
{
sprintf
(
nml_err_msg
,
"namelist read: misplaced = sign"
);
...
...
@@ -2663,7 +2732,8 @@ get_name:
{
if
(
!
is_separator
(
c
))
push_char
(
dtp
,
tolower
(
c
));
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
}
while
(
!
(
c
==
'='
||
c
==
' '
||
c
==
'\t'
||
c
==
'('
||
c
==
'%'
));
unget_char
(
dtp
,
c
);
...
...
@@ -2737,7 +2807,8 @@ get_name:
qualifier_flag
=
1
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
unget_char
(
dtp
,
c
);
}
else
if
(
nl
->
var_rank
>
0
)
...
...
@@ -2762,8 +2833,8 @@ get_name:
root_nl
=
nl
;
component_flag
=
1
;
c
=
next_char
(
dtp
)
;
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
goto
get_name
;
}
...
...
@@ -2799,7 +2870,8 @@ get_name:
goto
nml_err_ret
;
}
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
unget_char
(
dtp
,
c
);
}
...
...
@@ -2838,7 +2910,8 @@ get_name:
if
(
dtp
->
u
.
p
.
input_complete
)
return
SUCCESS
;
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
return
FAILURE
;
if
(
c
!=
'='
)
{
...
...
@@ -2883,8 +2956,7 @@ nml_err_ret:
void
namelist_read
(
st_parameter_dt
*
dtp
)
{
char
c
;
jmp_buf
eof_jump
;
int
c
;
char
nml_err_msg
[
200
];
/* Pointer to the previously read object, in case attempt is made to read
new object name. Should this fail, error message can give previous
...
...
@@ -2895,31 +2967,27 @@ namelist_read (st_parameter_dt *dtp)
dtp
->
u
.
p
.
input_complete
=
0
;
dtp
->
u
.
p
.
expanded_read
=
0
;
dtp
->
u
.
p
.
eof_jump
=
&
eof_jump
;
if
(
setjmp
(
eof_jump
))
{
dtp
->
u
.
p
.
eof_jump
=
NULL
;
generate_error
(
&
dtp
->
common
,
LIBERROR_END
,
NULL
);
return
;
}
/* Look for &namelist_name . Skip all characters, testing for $nmlname.
Exit on success or EOF. If '?' or '=?' encountered in stdin, print
node names or namelist on stdout. */
find_nml_name:
switch
(
c
=
next_char
(
dtp
))
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
nml_err_eof
;
switch
(
c
)
{
case
'$'
:
case
'&'
:
break
;
case
'!'
:
eat_line
(
dtp
);
if
(
eat_line
(
dtp
))
goto
nml_err_eof
;
goto
find_nml_name
;
case
'='
:
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
nml_err_eof
;
if
(
c
==
'?'
)
nml_query
(
dtp
,
'='
);
else
...
...
@@ -2941,7 +3009,8 @@ find_nml_name:
goto
find_nml_name
;
/* A trailing space is required, we give a little lattitude here, 10.9.1. */
c
=
next_char
(
dtp
);
if
((
c
=
next_char
(
dtp
))
==
EOF
)
goto
nml_err_eof
;
if
(
!
is_separator
(
c
)
&&
c
!=
'!'
)
{
unget_char
(
dtp
,
c
);
...
...
@@ -2965,16 +3034,17 @@ find_nml_name:
}
}
dtp
->
u
.
p
.
eof_jump
=
NULL
;
free_saved
(
dtp
);
free_line
(
dtp
);
return
;
/* All namelist error calls return from here */
nml_err_eof:
hit_eof
(
dtp
);
nml_err_ret:
dtp
->
u
.
p
.
eof_jump
=
NULL
;
free_saved
(
dtp
);
free_line
(
dtp
);
generate_error
(
&
dtp
->
common
,
LIBERROR_READ_VALUE
,
nml_err_msg
);
...
...
libgfortran/io/transfer.c
View file @
c86af7f3
...
...
@@ -2666,7 +2666,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
else
{
if
((
cf
&
IOPARM_DT_LIST_FORMAT
)
!=
0
)
dtp
->
u
.
p
.
transfer
=
list_formatted_read
;
{
dtp
->
u
.
p
.
last_char
=
EOF
-
1
;
dtp
->
u
.
p
.
transfer
=
list_formatted_read
;
}
else
dtp
->
u
.
p
.
transfer
=
formatted_transfer
;
}
...
...
@@ -3362,7 +3365,6 @@ next_record (st_parameter_dt *dtp, int done)
static
void
finalize_transfer
(
st_parameter_dt
*
dtp
)
{
jmp_buf
eof_jump
;
GFC_INTEGER_4
cf
=
dtp
->
common
.
flags
;
if
((
dtp
->
common
.
flags
&
IOPARM_DT_HAS_SIZE
)
!=
0
)
...
...
@@ -3394,13 +3396,6 @@ finalize_transfer (st_parameter_dt *dtp)
if
(
dtp
->
u
.
p
.
current_unit
==
NULL
)
return
;
dtp
->
u
.
p
.
eof_jump
=
&
eof_jump
;
if
(
setjmp
(
eof_jump
))
{
generate_error
(
&
dtp
->
common
,
LIBERROR_END
,
NULL
);
return
;
}
if
((
cf
&
IOPARM_DT_LIST_FORMAT
)
!=
0
&&
dtp
->
u
.
p
.
mode
==
READING
)
{
finish_list_read
(
dtp
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment