From f23886abacad045dae2b04895dddea4aaec2db1c Mon Sep 17 00:00:00 2001 From: tkoenig Date: Wed, 22 Mar 2006 19:09:11 +0000 Subject: [PATCH] 2006-03-22 Thomas Koenig PR fortran/19303 * gfortran.h (gfc_option_t): Add record_marker. * lang.opt: Add -frecord-marker=4 and -frecord-marker=8. * trans-decl.c: Add gfor_fndecl_set_record_marker. (gfc_build_builtin_function_decls): Set gfor_fndecl_set_record_marker. (gfc_generate_function_code): If we are in the main program and -frecord-marker was provided, call set_record_marker. * options.c (gfc_handle_option): Add handling for -frecord-marker=4 and -frecord-marker=8. * invoke.texi: Document -frecord-marker. 2006-03-22 Thomas Koenig PR fortran/19303 * libgfortran.h (compile_options_t): Add record_marker. * runtime/compile_options.c (set_record_marker): New function. * io/open.c: If we have four-byte record markers, use GFC_INTEGER_4_HUGE as default record length. * io/file_pos.c (unformatted_backspace): Handle different size record markers. * io/transfer.c (us_read): Likewise. (us_write): Likewise. (next_record_r): Likewise. (write_us_marker): Likewise. (next_record_w): Likewise. 2006-03-22 Thomas Koenig PR fortran/19303 * gfortran.dg/record_marker_1.f90: New test case. * gfortran.dg/record_marker_2.f: New test case. * gfortran.dg/record_marker_3.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112290 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 16 ++- gcc/fortran/gfortran.h | 1 + gcc/fortran/invoke.texi | 13 ++- gcc/fortran/lang.opt | 8 ++ gcc/fortran/options.c | 8 ++ gcc/fortran/trans-decl.c | 20 ++++ gcc/testsuite/ChangeLog | 7 ++ gcc/testsuite/gfortran.dg/record_marker_1.f90 | 38 +++++++ gcc/testsuite/gfortran.dg/record_marker_2.f | 83 ++++++++++++++ gcc/testsuite/gfortran.dg/record_marker_3.f90 | 38 +++++++ libgfortran/ChangeLog | 16 +++ libgfortran/io/file_pos.c | 62 +++++++++-- libgfortran/io/open.c | 21 +++- libgfortran/io/transfer.c | 149 ++++++++++++++++++++++---- libgfortran/libgfortran.h | 1 + libgfortran/runtime/compile_options.c | 26 +++++ 16 files changed, 480 insertions(+), 27 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/record_marker_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/record_marker_2.f create mode 100644 gcc/testsuite/gfortran.dg/record_marker_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e36bff416a..da2cc081062 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,7 +1,21 @@ +2006-03-22 Thomas Koenig + + PR fortran/19303 + * gfortran.h (gfc_option_t): Add record_marker. + * lang.opt: Add -frecord-marker=4 and -frecord-marker=8. + * trans-decl.c: Add gfor_fndecl_set_record_marker. + (gfc_build_builtin_function_decls): Set + gfor_fndecl_set_record_marker. + (gfc_generate_function_code): If we are in the main program + and -frecord-marker was provided, call set_record_marker. + * options.c (gfc_handle_option): Add handling for + -frecord-marker=4 and -frecord-marker=8. + * invoke.texi: Document -frecord-marker. + 2006-03-22 Paul Thomas PR fortran/17298 - *trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): New + * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): New function to implement array valued TRANSFER intrinsic. (gfc_conv_intrinsic_function): Call the new function if TRANSFER and non-null se->ss. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 24c92b3e0eb..3e673a8ccf5 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1641,6 +1641,7 @@ typedef struct int warn_nonstd_intrinsics; int fshort_enums; int convert; + int record_marker; } gfc_option_t; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 627d7782fcb..e95b32b70ac 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -145,7 +145,7 @@ by type. Explanations are in the following sections. @item Runtime Options @xref{Runtime Options,,Options for influencing runtime behavior}. @gccoptlist{ --fconvert=@var{conversion}} +-fconvert=@var{conversion} -frecord-marker=@var{length}} @item Code Generation Options @xref{Code Gen Options,,Options for Code Generation Conventions}. @@ -613,6 +613,17 @@ representation for unformatted files. @emph{This option has an effect only when used in the main program. The @code{CONVERT} specifier and the GFORTRAN_CONVERT_UNIT environment variable override the default specified by -fconvert.} + +@cindex -frecord-marker=@var{length} +@item -frecord-marker=@var{length} +Specify the length of record markers for unformatted files. +Valid values for @var{length} are 4 and 8. Default is whatever +@code{off_t} is specified to be on that particular system. +Note that specifying @var{length} as 4 limits the record +length of unformatted files to 2 GB. This option does not +extend the maximum possible record length on systems where +@code{off_t} is a four_byte quantity. + @end table @node Code Gen Options diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 7f38e109a0a..853653abfeb 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -233,4 +233,12 @@ fconvert=swap Fortran RejectNegative Swap endianness for unformatted files +frecord-marker=4 +Fortran RejectNegative +Use a 4-byte record marker for unformatted files + +frecord-marker=8 +Fortran RejectNegative +Use an 8-byte record marker for unformatted files + ; This comment is to ensure we retain the blank line above. diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 438bc48ad55..18d56c560b0 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -615,6 +615,14 @@ gfc_handle_option (size_t scode, const char *arg, int value) case OPT_fconvert_swap: gfc_option.convert = CONVERT_SWAP; break; + + case OPT_frecord_marker_4: + gfc_option.record_marker = 4; + break; + + case OPT_frecord_marker_8: + gfc_option.record_marker = 8; + break; } return result; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e8d2cd10389..2a9c0dbc32f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -93,6 +93,7 @@ tree gfor_fndecl_runtime_error; tree gfor_fndecl_set_fpe; tree gfor_fndecl_set_std; tree gfor_fndecl_set_convert; +tree gfor_fndecl_set_record_marker; tree gfor_fndecl_ctime; tree gfor_fndecl_fdate; tree gfor_fndecl_ttynam; @@ -2297,6 +2298,10 @@ gfc_build_builtin_function_decls (void) gfc_build_library_function_decl (get_identifier (PREFIX("set_convert")), void_type_node, 1, gfc_c_int_type_node); + gfor_fndecl_set_record_marker = + gfc_build_library_function_decl (get_identifier (PREFIX("set_record_marker")), + void_type_node, 1, gfc_c_int_type_node); + gfor_fndecl_in_pack = gfc_build_library_function_decl ( get_identifier (PREFIX("internal_pack")), pvoid_type_node, 1, pvoid_type_node); @@ -2943,6 +2948,21 @@ gfc_generate_function_code (gfc_namespace * ns) gfc_add_expr_to_block (&body, tmp); } + /* If this is the main program and an -frecord-marker option was provided, + add a call to set_record_marker. */ + + if (sym->attr.is_main_program && gfc_option.record_marker != 0) + { + tree arglist, gfc_c_int_type_node; + + gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); + arglist = gfc_chainon_list (NULL_TREE, + build_int_cst (gfc_c_int_type_node, + gfc_option.record_marker)); + tmp = build_function_call_expr (gfor_fndecl_set_record_marker, arglist); + gfc_add_expr_to_block (&body, tmp); + + } if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node && sym->attr.subroutine) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 20bb9c6568b..0c83ee3680d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-03-22 Thomas Koenig + + PR fortran/19303 + * gfortran.dg/record_marker_1.f90: New test case. + * gfortran.dg/record_marker_2.f: New test case. + * gfortran.dg/record_marker_3.f90: New test case. + 2006-03-22 Paul Thomas PR fortran/17298 diff --git a/gcc/testsuite/gfortran.dg/record_marker_1.f90 b/gcc/testsuite/gfortran.dg/record_marker_1.f90 new file mode 100644 index 00000000000..8312171d474 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/record_marker_1.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-frecord-marker=4" } + +program main + implicit none + integer :: i1, i2, i3 + + open(15,form="UNFORMATTED") + write (15) 1 + close (15) + open (15,form="UNFORMATTED",access="DIRECT",recl=4) + i1 = 1 + i2 = 2 + i3 = 3 + read (15,rec=1) i1 + read (15,rec=2) i2 + read (15,rec=3) i3 + close (15, status="DELETE") + if (i1 /= 4) call abort + if (i2 /= 1) call abort + if (i3 /= 4) call abort + + open(15,form="UNFORMATTED",convert="SWAP") + write (15) 1 + close (15) + open (15,form="UNFORMATTED",access="DIRECT",convert="SWAP",recl=4) + i1 = 1 + i2 = 2 + i3 = 3 + read (15,rec=1) i1 + read (15,rec=2) i2 + read (15,rec=3) i3 + close(15,status="DELETE") + if (i1 /= 4) call abort + if (i2 /= 1) call abort + if (i3 /= 4) call abort + +end program main diff --git a/gcc/testsuite/gfortran.dg/record_marker_2.f b/gcc/testsuite/gfortran.dg/record_marker_2.f new file mode 100644 index 00000000000..725af120d33 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/record_marker_2.f @@ -0,0 +1,83 @@ +! { dg-do run } +! { dg-options "-frecord-marker=4" } +! This file is all about BACKSPACE +! Adapted from gfortran.dg/backspace.f + + integer i, n, nr + real x(10), y(10) + +! PR libfortran/20068 + open (20, status='scratch') + write (20,*) 1 + write (20,*) 2 + write (20,*) 3 + rewind (20) + read (20,*) i + if (i .ne. 1) call abort + backspace (20) + read (20,*) i + if (i .ne. 1) call abort + close (20) + +! PR libfortran/20125 + open (20, status='scratch') + write (20,*) 7 + backspace (20) + read (20,*) i + if (i .ne. 7) call abort + close (20) + + open (20, status='scratch', form='unformatted') + write (20) 8 + backspace (20) + read (20) i + if (i .ne. 8) call abort + close (20) + +! PR libfortran/20471 + do n = 1, 10 + x(n) = sqrt(real(n)) + end do + open (3, form='unformatted', status='scratch') + write (3) (x(n),n=1,10) + backspace (3) + rewind (3) + read (3) (y(n),n=1,10) + + do n = 1, 10 + if (abs(x(n)-y(n)) > 0.00001) call abort + end do + close (3) + +! PR libfortran/20156 + open (3, form='unformatted', status='scratch') + do i = 1, 5 + x(1) = i + write (3) n, (x(n),n=1,10) + end do + nr = 0 + rewind (3) + 20 continue + read (3,end=30,err=90) n, (x(n),n=1,10) + nr = nr + 1 + goto 20 + 30 continue + if (nr .ne. 5) call abort + + do i = 1, nr+1 + backspace (3) + end do + + do i = 1, nr + read(3,end=70,err=90) n, (x(n),n=1,10) + if (abs(x(1) - i) .gt. 0.001) call abort + end do + close (3) + stop + + 70 continue + call abort + 90 continue + call abort + + end diff --git a/gcc/testsuite/gfortran.dg/record_marker_3.f90 b/gcc/testsuite/gfortran.dg/record_marker_3.f90 new file mode 100644 index 00000000000..7459d7210a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/record_marker_3.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-frecord-marker=8" } + +program main + implicit none + integer (kind=8) :: i1, i2, i3 + + open(15,form="UNFORMATTED") + write (15) 1_8 + close (15) + open (15,form="UNFORMATTED",access="DIRECT",recl=8) + i1 = 1 + i2 = 2 + i3 = 3 + read (15,rec=1) i1 + read (15,rec=2) i2 + read (15,rec=3) i3 + close (15, status="DELETE") + if (i1 /= 8) call abort + if (i2 /= 1) call abort + if (i3 /= 8) call abort + + open(15,form="UNFORMATTED",convert="SWAP") + write (15) 1_8 + close (15) + open (15,form="UNFORMATTED",access="DIRECT",convert="SWAP",recl=8) + i1 = 1 + i2 = 2 + i3 = 3 + read (15,rec=1) i1 + read (15,rec=2) i2 + read (15,rec=3) i3 + close(15,status="DELETE") + if (i1 /= 8) call abort + if (i2 /= 1) call abort + if (i3 /= 8) call abort + +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 9a0a8086f41..bfb7627d765 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,19 @@ +2006-03-22 Thomas Koenig + + PR fortran/19303 + * libgfortran.h (compile_options_t): Add record_marker. + * runtime/compile_options.c (set_record_marker): + New function. + * io/open.c: If we have four-byte record markers, use + GFC_INTEGER_4_HUGE as default record length. + * io/file_pos.c (unformatted_backspace): Handle + different size record markers. + * io/transfer.c (us_read): Likewise. + (us_write): Likewise. + (next_record_r): Likewise. + (write_us_marker): Likewise. + (next_record_w): Likewise. + 2006-03-20 Thomas Koenig PR fortran/20935 diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 5d247d9c6b3..fd6333a667e 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -104,21 +104,71 @@ static void unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) { gfc_offset m, new; - int length; + GFC_INTEGER_4 m4; + GFC_INTEGER_8 m8; + int length, length_read; char *p; - length = sizeof (gfc_offset); + if (compile_options.record_marker == 0) + length = sizeof (gfc_offset); + else + length = compile_options.record_marker; + + length_read = length; - p = salloc_r_at (u->s, &length, + p = salloc_r_at (u->s, &length_read, file_position (u->s) - length); - if (p == NULL) + if (p == NULL || length_read != length) goto io_error; /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ if (u->flags.convert == CONVERT_NATIVE) - memcpy (&m, p, sizeof (gfc_offset)); + { + switch (compile_options.record_marker) + { + case 0: + memcpy (&m, p, sizeof(gfc_offset)); + break; + + case sizeof(GFC_INTEGER_4): + memcpy (&m4, p, sizeof (m4)); + m = m4; + break; + + case sizeof(GFC_INTEGER_8): + memcpy (&m8, p, sizeof (m8)); + m = m8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } else - reverse_memcpy (&m, p, sizeof (gfc_offset)); + { + switch (compile_options.record_marker) + { + case 0: + reverse_memcpy (&m, p, sizeof(gfc_offset)); + break; + + case sizeof(GFC_INTEGER_4): + reverse_memcpy (&m4, p, sizeof (m4)); + m = m4; + break; + + case sizeof(GFC_INTEGER_8): + reverse_memcpy (&m8, p, sizeof (m8)); + m = m8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + + } if ((new = file_position (u->s) - m - 2*length) < 0) new = 0; diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 528188bce9f..24713b76f49 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -399,7 +399,26 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) u->recl = opp->recl_in; else - u->recl = max_offset; + { + switch (compile_options.record_marker) + { + case 0: + u->recl = max_offset; + break; + + case sizeof (GFC_INTEGER_4): + u->recl = GFC_INTEGER_4_HUGE; + break; + + case sizeof (GFC_INTEGER_8): + u->recl = max_offset; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } /* If the file is direct access, calculate the maximum record number via a division now instead of letting the multiplication overflow diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 4626d46b7ad..32e3881c27f 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1230,12 +1230,21 @@ us_read (st_parameter_dt *dtp) { char *p; int n; + int nr; + GFC_INTEGER_4 i4; + GFC_INTEGER_8 i8; gfc_offset i; if (dtp->u.p.current_unit->endfile == AT_ENDFILE) return; - n = sizeof (gfc_offset); + if (compile_options.record_marker == 0) + n = sizeof (gfc_offset); + else + n = compile_options.record_marker; + + nr = n; + p = salloc_r (dtp->u.p.current_unit->s, &n); if (n == 0) @@ -1244,7 +1253,7 @@ us_read (st_parameter_dt *dtp) return; /* end of file */ } - if (p == NULL || n != sizeof (gfc_offset)) + if (p == NULL || n != nr) { generate_error (&dtp->common, ERROR_BAD_US, NULL); return; @@ -1252,10 +1261,50 @@ us_read (st_parameter_dt *dtp) /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) - memcpy (&i, p, sizeof (gfc_offset)); + { + switch (compile_options.record_marker) + { + case 0: + memcpy (&i, p, sizeof(gfc_offset)); + break; + + case sizeof(GFC_INTEGER_4): + memcpy (&i4, p, sizeof (i4)); + i = i4; + break; + + case sizeof(GFC_INTEGER_8): + memcpy (&i8, p, sizeof (i8)); + i = i8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } else - reverse_memcpy (&i, p, sizeof (gfc_offset)); - + switch (compile_options.record_marker) + { + case 0: + reverse_memcpy (&i, p, sizeof(gfc_offset)); + break; + + case sizeof(GFC_INTEGER_4): + reverse_memcpy (&i4, p, sizeof (i4)); + i = i4; + break; + + case sizeof(GFC_INTEGER_8): + reverse_memcpy (&i8, p, sizeof (i8)); + i = i8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + dtp->u.p.current_unit->bytes_left = i; } @@ -1270,7 +1319,11 @@ us_write (st_parameter_dt *dtp) gfc_offset dummy; dummy = 0; - nbytes = sizeof (gfc_offset); + + if (compile_options.record_marker == 0) + nbytes = sizeof (gfc_offset); + else + nbytes = compile_options.record_marker ; if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0) generate_error (&dtp->common, ERROR_OS, NULL); @@ -1673,7 +1726,9 @@ next_record_r (st_parameter_dt *dtp) case UNFORMATTED_SEQUENTIAL: /* Skip over tail */ - dtp->u.p.current_unit->bytes_left += sizeof (gfc_offset); + dtp->u.p.current_unit->bytes_left += + compile_options.record_marker == 0 ? + sizeof (gfc_offset) : compile_options.record_marker; /* Fall through... */ @@ -1773,20 +1828,72 @@ next_record_r (st_parameter_dt *dtp) /* Small utility function to write a record marker, taking care of - byte swapping. */ + byte swapping and of choosing the correct size. */ inline static int write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) { - size_t len = sizeof (gfc_offset); + size_t len; + GFC_INTEGER_4 buf4; + GFC_INTEGER_8 buf8; + char p[sizeof (GFC_INTEGER_8)]; + + if (compile_options.record_marker == 0) + len = sizeof (gfc_offset); + else + len = compile_options.record_marker; + /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) - return swrite (dtp->u.p.current_unit->s, &buf, &len); - else { - gfc_offset p; - reverse_memcpy (&p, &buf, sizeof (gfc_offset)); - return swrite (dtp->u.p.current_unit->s, &p, &len); - } + { + switch (compile_options.record_marker) + { + case 0: + return swrite (dtp->u.p.current_unit->s, &buf, &len); + break; + + case sizeof (GFC_INTEGER_4): + buf4 = buf; + return swrite (dtp->u.p.current_unit->s, &buf4, &len); + break; + + case sizeof (GFC_INTEGER_8): + buf8 = buf; + return swrite (dtp->u.p.current_unit->s, &buf8, &len); + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + else + { + switch (compile_options.record_marker) + { + case 0: + reverse_memcpy (p, &buf, sizeof (gfc_offset)); + return swrite (dtp->u.p.current_unit->s, p, &len); + break; + + case sizeof (GFC_INTEGER_4): + buf4 = buf; + reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4)); + return swrite (dtp->u.p.current_unit->s, p, &len); + break; + + case sizeof (GFC_INTEGER_8): + buf8 = buf; + reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_4)); + return swrite (dtp->u.p.current_unit->s, p, &len); + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + } @@ -1798,6 +1905,7 @@ next_record_w (st_parameter_dt *dtp, int done) gfc_offset c, m, record, max_pos; int length; char *p; + size_t record_marker; /* Zero counters for X- and T-editing. */ max_pos = dtp->u.p.max_pos; @@ -1830,11 +1938,16 @@ next_record_w (st_parameter_dt *dtp, int done) if (write_us_marker (dtp, m) != 0) goto io_error; + if (compile_options.record_marker == 4) + record_marker = sizeof(GFC_INTEGER_4); + else + record_marker = sizeof (gfc_offset); + /* Seek to the head and overwrite the bogus length with the real length. */ - if (sseek (dtp->u.p.current_unit->s, c - m - sizeof (gfc_offset)) - == FAILURE) + if (sseek (dtp->u.p.current_unit->s, c - m - record_marker) + == FAILURE) goto io_error; if (write_us_marker (dtp, m) != 0) @@ -1842,7 +1955,7 @@ next_record_w (st_parameter_dt *dtp, int done) /* Seek past the end of the current record. */ - if (sseek (dtp->u.p.current_unit->s, c + sizeof (gfc_offset)) == FAILURE) + if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE) goto io_error; break; diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 8316540416d..8a57bfaf17c 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -338,6 +338,7 @@ typedef struct int allow_std; int pedantic; int convert; + size_t record_marker; } compile_options_t; diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c index ce5e52a34da..fb6ac509f13 100644 --- a/libgfortran/runtime/compile_options.c +++ b/libgfortran/runtime/compile_options.c @@ -74,3 +74,29 @@ set_convert (int conv) { compile_options.convert = conv; } + +extern void set_record_marker (int); +export_proto (set_record_marker); + + +void +set_record_marker (int val) +{ + + switch(val) + { + case 4: + if (sizeof (GFC_INTEGER_4) != sizeof (gfc_offset)) + compile_options.record_marker = sizeof (GFC_INTEGER_4); + break; + + case 8: + if (sizeof (GFC_INTEGER_8) != sizeof (gfc_offset)) + compile_options.record_marker = sizeof (GFC_INTEGER_8); + break; + + default: + runtime_error ("Invalid value for record marker"); + break; + } +} -- 2.11.4.GIT