On 03/09/2014 05:39 PM, Jerry DeLisle wrote:
> Hi all,
>
> This final patch does two things.
>
> First: In read.c it implements a simple space skipping scheme in read_decimal
> where I found a lot of repeated next_char calls happening. This gives a pretty
> good boost in performance and is applicable in general for reading integers.
>
> Second: I have taken Thomas idea of using LEN_TRIM in unit.c revised it to
> work
> on formatted READ. I tried to document the code with comments. There are
> certain conditions for which one can not shorten the string length for
> internal
> units. For arrays of characters you can not do this for strings more than
> rank 1
> and stride 1. Also, you can not do this any time a BLANK='zero' is being
> used. I
> also skip the optimization if there is any BLANK= specified in the READ. Thats
> conservative. I could also test for BLANK='NULL' in the DTP structure. I will
> probably do that later.
>
> I have added a helper function which tests for the BZ within a format string
> when a format string is present. I also check to see if the UNIT has had the
> BLANK status set. The optimization is skipped for these conditions.
>
Updated patch to resolve issue found during NIST tests.
Regression tested and NIST tested.
OK for trunk?
Regards,
Jerry
Index: read.c
===================================================================
--- read.c (revision 208303)
+++ read.c (working copy)
@@ -677,7 +677,13 @@ read_decimal (st_parameter_dt *dtp, const fnode *f
if (c == ' ')
{
- if (dtp->u.p.blank_status == BLANK_NULL) continue;
+ if (dtp->u.p.blank_status == BLANK_NULL)
+ {
+ /* Skip spaces. */
+ for ( ; w > 0; p++, w--)
+ if (*p != ' ') break;
+ continue;
+ }
if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
}
Index: unit.c
===================================================================
--- unit.c (revision 208303)
+++ unit.c (working copy)
@@ -375,6 +375,38 @@ find_or_create_unit (int n)
}
+/* Helper function to test conditions in format string. This
+ is used for optimization. You can't trim out blanks or shorten the
+ string if blank length is significant. */
+static bool
+is_trim_ok (st_parameter_dt *dtp)
+{
+ /* Check rank and stride. */
+ if (dtp->internal_unit_desc
+ && (GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc) > 1
+ || GFC_DESCRIPTOR_STRIDE(dtp->internal_unit_desc, 0) != 1))
+ return false;
+ /* Format strings can not have 'BZ' or '/'. */
+ if (dtp->common.flags & IOPARM_DT_HAS_FORMAT)
+ {
+ char *p = dtp->format;
+ off_t i;
+ if (dtp->common.flags & IOPARM_DT_HAS_BLANK)
+ return false;
+ for (i = 0; i < dtp->format_len; i++)
+ {
+ if (p[i] == '/') return false;
+ if (p[i] == 'b' || p[i] == 'B')
+ if (p[i+1] == 'z' || p[i+1] == 'Z')
+ return false;
+ }
+ }
+ if (dtp->u.p.ionml) /* A namelist. */
+ return false;
+ return true;
+}
+
+
gfc_unit *
get_internal_unit (st_parameter_dt *dtp)
{
@@ -402,6 +434,30 @@ get_internal_unit (st_parameter_dt *dtp)
some other file I/O unit. */
iunit->unit_number = -1;
+ /* As an optimization, adjust the unit record length to not
+ include trailing blanks. This will not work under certain conditions
+ where trailing blanks have significance. */
+ if (dtp->u.p.mode == READING && is_trim_ok (dtp))
+ {
+ int len = 0;
+ if (dtp->common.unit == 0)
+ {
+ len = string_len_trim (dtp->internal_unit_len,
+ dtp->internal_unit);
+ if (len > 0)
+ dtp->internal_unit_len = len;
+ iunit->recl = dtp->internal_unit_len;
+ }
+ else
+ {
+ len = string_len_trim_char4 (dtp->internal_unit_len,
+ (const gfc_char4_t*) dtp->internal_unit);
+ if (len > 0)
+ dtp->internal_unit_len = len;
+ iunit->recl = dtp->internal_unit_len;
+ }
+ }
+
/* Set up the looping specification from the array descriptor, if any. */
if (is_array_io (dtp))
@@ -414,27 +470,6 @@ get_internal_unit (st_parameter_dt *dtp)
start_record *= iunit->recl;
}
- else
- {
- /* If we are not processing an array, adjust the unit record length not
- to include trailing blanks for list-formatted reads. */
- if (dtp->u.p.mode == READING && !(dtp->common.flags & IOPARM_DT_HAS_FORMAT))
- {
- if (dtp->common.unit == 0)
- {
- dtp->internal_unit_len =
- string_len_trim (dtp->internal_unit_len, dtp->internal_unit);
- iunit->recl = dtp->internal_unit_len;
- }
- else
- {
- dtp->internal_unit_len =
- string_len_trim_char4 (dtp->internal_unit_len,
- (const gfc_char4_t*) dtp->internal_unit);
- iunit->recl = dtp->internal_unit_len;
- }
- }
- }
/* Set initial values for unit parameters. */
if (dtp->common.unit)
