diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2006-03-22 19:09:11 +0000 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2006-03-22 19:09:11 +0000 |
commit | d67ab5eef80ed2d4891562bf5ff791c1b2af4a97 (patch) | |
tree | ddee91463b1c5b5ef8aaf5e8a3581d490478bed9 | |
parent | 4dc7782d15938a44634f16465a4dab55a25d70d2 (diff) | |
download | gcc-d67ab5eef80ed2d4891562bf5ff791c1b2af4a97.zip gcc-d67ab5eef80ed2d4891562bf5ff791c1b2af4a97.tar.gz gcc-d67ab5eef80ed2d4891562bf5ff791c1b2af4a97.tar.bz2 |
[multiple changes]
2006-03-22 Thomas Koenig <Thomas.Koenig@onlien.de>
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 <Thomas.Koenig@onlien.de>
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 <Thomas.Koenig@online.de>
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.
From-SVN: r112290
-rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
-rw-r--r-- | gcc/fortran/invoke.texi | 13 | ||||
-rw-r--r-- | gcc/fortran/lang.opt | 8 | ||||
-rw-r--r-- | gcc/fortran/options.c | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 20 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/record_marker_1.f90 | 38 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/record_marker_2.f | 83 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/record_marker_3.f90 | 38 | ||||
-rw-r--r-- | libgfortran/ChangeLog | 16 | ||||
-rw-r--r-- | libgfortran/io/file_pos.c | 62 | ||||
-rw-r--r-- | libgfortran/io/open.c | 21 | ||||
-rw-r--r-- | libgfortran/io/transfer.c | 149 | ||||
-rw-r--r-- | libgfortran/libgfortran.h | 1 | ||||
-rw-r--r-- | libgfortran/runtime/compile_options.c | 26 |
16 files changed, 480 insertions, 27 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e36bff..da2cc08 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,7 +1,21 @@ +2006-03-22 Thomas Koenig <Thomas.Koenig@online.de> + + 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 <pault@gcc.gnu.org> 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 24c92b3..3e673a8 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 627d778..e95b32b 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 7f38e10..853653a 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 438bc48..18d56c5 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 e8d2cd1..2a9c0db 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 20bb9c6..0c83ee3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-03-22 Thomas Koenig <Thomas.Koenig@online.de> + + 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 <pault@gcc.gnu.org> 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 0000000..8312171 --- /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 0000000..725af12 --- /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 0000000..7459d72 --- /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 9a0a808..bfb7627 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,19 @@ +2006-03-22 Thomas Koenig <Thomas.Koenig@online.de> + + 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 <Thomas.Koenig@online.de> PR fortran/20935 diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 5d247d9..fd6333a 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 528188b..24713b7 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 4626d46..32e3881 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 8316540..8a57bfa 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 ce5e52a..fb6ac50 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; + } +} |