From: bdavis Date: Mon, 26 Sep 2005 20:24:45 +0000 (+0000) Subject: 2005-09-24 Janne Blomqvist X-Git-Tag: upstream/4.9.2~58472 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=fd5a251845470c863d1a5c50cae5caf12118a3d8;p=platform%2Fupstream%2Flinaro-gcc.git 2005-09-24 Janne Blomqvist * trans-io.c (gfc_build_io_library_fndecls): Add entry iocall_x_array for transfer_array. (transfer_array_desc): New function. (gfc_trans_transfer): Add code to call transfer_array_desc. 2005-09-24 Janne Blomqvist * io.h: Changed prototypes of list_formatted_{read|write}. * list_read.c (list_formatted_read): Renamed to list_formatted_read_scalar and made static. (list_formatted_read): New function. * transfer.c: Prototype for transfer_array. Changed transfer function pointer. (unformatted_read): Add nelems argument, use it. (unformatted_write): Likewise. (formatted_transfer): Changed name to formatted_transfer_scalar. (formatted_transfer): New function. (transfer_integer): Add nelems argument to transfer call, move updating item count to transfer functions. (transfer_real): Likewise. (transfer_logical): Likewise. (transfer_character): Likewise. (transfer_complex): Likewise. (transfer_array): New function. (data_transfer_init): Call formatted_transfer with new argument. (iolength_transfer): New argument, use it. * write.c (list_formatted_write): Renamed to list_formatted_write_scalar, made static. (list_formatted_write): New function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104662 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a376443..3044bdf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-09-24 Janne Blomqvist + + * trans-io.c (gfc_build_io_library_fndecls): Add entry + iocall_x_array for transfer_array. (transfer_array_desc): New + function. (gfc_trans_transfer): Add code to call + transfer_array_desc. + 2005-09-26 Jakub Jelinek PR fortran/23677 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 41f4ae8..2c8a9cd 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -120,6 +120,7 @@ static GTY(()) tree iocall_x_logical; static GTY(()) tree iocall_x_character; static GTY(()) tree iocall_x_real; static GTY(()) tree iocall_x_complex; +static GTY(()) tree iocall_x_array; static GTY(()) tree iocall_open; static GTY(()) tree iocall_close; static GTY(()) tree iocall_inquire; @@ -267,6 +268,12 @@ gfc_build_io_library_fndecls (void) void_type_node, 2, pvoid_type_node, gfc_int4_type_node); + iocall_x_array = + gfc_build_library_function_decl (get_identifier + (PREFIX("transfer_array")), + void_type_node, 2, pvoid_type_node, + gfc_charlen_type_node); + /* Library entry points */ iocall_read = @@ -1584,6 +1591,27 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) } +/* Generate a call to pass an array descriptor to the IO library. The + array should be of one of the intrinsic types. */ + +static void +transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr) +{ + tree args, tmp, charlen_arg; + + if (ts->type == BT_CHARACTER) + charlen_arg = se->string_length; + else + charlen_arg = build_int_cstu (NULL_TREE, 0); + + args = gfc_chainon_list (NULL_TREE, addr_expr); + args = gfc_chainon_list (args, charlen_arg); + tmp = gfc_build_function_call (iocall_x_array, args); + gfc_add_expr_to_block (&se->pre, tmp); + gfc_add_block_to_block (&se->pre, &se->post); +} + + /* gfc_trans_transfer()-- Translate a TRANSFER code node */ tree @@ -1597,6 +1625,7 @@ gfc_trans_transfer (gfc_code * code) tree tmp; gfc_start_block (&block); + gfc_init_block (&body); expr = code->expr; ss = gfc_walk_expr (expr); @@ -1604,8 +1633,11 @@ gfc_trans_transfer (gfc_code * code) gfc_init_se (&se, NULL); if (ss == gfc_ss_terminator) - gfc_init_block (&body); - else + { + gfc_conv_expr_reference (&se, expr); + transfer_expr (&se, &expr->ts, se.expr); + } + else if (expr->ts.type == BT_DERIVED) { /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); @@ -1621,11 +1653,17 @@ gfc_trans_transfer (gfc_code * code) gfc_copy_loopinfo_to_se (&se, &loop); se.ss = ss; - } - - gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr); + gfc_conv_expr_reference (&se, expr); + transfer_expr (&se, &expr->ts, se.expr); + } + else + { + /* Pass the array descriptor to the library. */ + gfc_conv_expr_descriptor (&se, expr, ss); + tmp = gfc_build_addr_expr (NULL, se.expr); + transfer_array_desc (&se, &expr->ts, tmp); + } gfc_add_block_to_block (&body, &se.pre); gfc_add_block_to_block (&body, &se.post); diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 70ef38d..2b27b43 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,24 @@ +2005-09-24 Janne Blomqvist + + * io.h: Changed prototypes of list_formatted_{read|write}. + * list_read.c (list_formatted_read): Renamed to + list_formatted_read_scalar and made static. (list_formatted_read): + New function. + * transfer.c: Prototype for transfer_array. Changed transfer + function pointer. (unformatted_read): Add nelems argument, use + it. (unformatted_write): Likewise. (formatted_transfer): Changed + name to formatted_transfer_scalar. (formatted_transfer): New + function. (transfer_integer): Add nelems argument to transfer + call, move updating item count to transfer + functions. (transfer_real): Likewise. (transfer_logical): + Likewise. (transfer_character): Likewise. (transfer_complex): + Likewise. (transfer_array): New function. (data_transfer_init): + Call formatted_transfer with new argument. (iolength_transfer): + New argument, use it. + * write.c (list_formatted_write): Renamed to + list_formatted_write_scalar, made static. (list_formatted_write): + New function. + 2005-09-26 David Edelsohn * configure.ac: Add check for __clog. diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 4f5f88a..65051fa 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -613,7 +613,7 @@ internal_proto(read_decimal); /* list_read.c */ -extern void list_formatted_read (bt, void *, int); +extern void list_formatted_read (bt, void *, int, size_t); internal_proto(list_formatted_read); extern void finish_list_read (void); @@ -666,7 +666,7 @@ internal_proto(write_x); extern void write_z (fnode *, const char *, int); internal_proto(write_z); -extern void list_formatted_write (bt, void *, int); +extern void list_formatted_write (bt, void *, int, size_t); internal_proto(list_formatted_write); /* error.c */ diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 9d51f02..c3510f6 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1285,8 +1285,8 @@ check_type (bt type, int len) reading, usually in the value[] array. If a repeat count is greater than one, we copy the data item multiple times. */ -void -list_formatted_read (bt type, void *p, int len) +static void +list_formatted_read_scalar (bt type, void *p, int len) { char c; int m; @@ -1406,6 +1406,30 @@ list_formatted_read (bt type, void *p, int len) free_saved (); } + +void +list_formatted_read (bt type, void *p, int len, size_t nelems) +{ + size_t elem; + int size; + char *tmp; + + tmp = (char *) p; + + if (type == BT_COMPLEX) + size = 2 * len; + else + size = len; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + g.item_count++; + list_formatted_read_scalar (type, tmp + size*elem, len); + } +} + + void init_at_eol(void) { diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index a279f92..ca9246b 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -78,6 +78,9 @@ export_proto(transfer_character); extern void transfer_complex (void *, int); export_proto(transfer_complex); +extern void transfer_array (gfc_array_char *, gfc_charlen_type); +export_proto(transfer_array); + gfc_unit *current_unit = NULL; static int sf_seen_eor = 0; static int eor_condition = 0; @@ -101,7 +104,7 @@ static st_option advance_opt[] = { }; -static void (*transfer) (bt, void *, int); +static void (*transfer) (bt, void *, int, size_t); typedef enum @@ -312,11 +315,13 @@ write_block (int length) /* Master function for unformatted reads. */ static void -unformatted_read (bt type, void *dest, int length) +unformatted_read (bt type, void *dest, int length, size_t nelems) { void *source; int w; + length *= nelems; + /* Transfer functions get passed the kind of the entity, so we have to fix this for COMPLEX data which are twice the size of their kind. */ @@ -337,17 +342,20 @@ unformatted_read (bt type, void *dest, int length) /* Master function for unformatted writes. */ static void -unformatted_write (bt type, void *source, int length) +unformatted_write (bt type, void *source, int length, size_t nelems) { void *dest; + size_t len; + + len = length * nelems; /* Correction for kind vs. length as in unformatted_read. */ if (type == BT_COMPLEX) - length *= 2; + len *= 2; - dest = write_block (length); + dest = write_block (len); if (dest != NULL) - memcpy (dest, source, length); + memcpy (dest, source, len); } @@ -442,7 +450,7 @@ require_type (bt expected, bt actual, fnode * f) of the next element, then comes back here to process it. */ static void -formatted_transfer (bt type, void *p, int len) +formatted_transfer_scalar (bt type, void *p, int len) { int pos, bytes_used; fnode *f; @@ -837,6 +845,29 @@ formatted_transfer (bt type, void *p, int len) unget_format (f); } +static void +formatted_transfer (bt type, void *p, int len, size_t nelems) +{ + size_t elem; + int size; + char *tmp; + + tmp = (char *) p; + + if (type == BT_COMPLEX) + size = 2 * len; + else + size = len; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + g.item_count++; + formatted_transfer_scalar (type, tmp + size*elem, len); + } +} + + /* Data transfer entry points. The type of the data entity is implicit in the subroutine call. This prevents us from having to @@ -845,50 +876,153 @@ formatted_transfer (bt type, void *p, int len) void transfer_integer (void *p, int kind) { - g.item_count++; if (ioparm.library_return != LIBRARY_OK) return; - transfer (BT_INTEGER, p, kind); + transfer (BT_INTEGER, p, kind, 1); } void transfer_real (void *p, int kind) { - g.item_count++; if (ioparm.library_return != LIBRARY_OK) return; - transfer (BT_REAL, p, kind); + transfer (BT_REAL, p, kind, 1); } void transfer_logical (void *p, int kind) { - g.item_count++; if (ioparm.library_return != LIBRARY_OK) return; - transfer (BT_LOGICAL, p, kind); + transfer (BT_LOGICAL, p, kind, 1); } void transfer_character (void *p, int len) { - g.item_count++; if (ioparm.library_return != LIBRARY_OK) return; - transfer (BT_CHARACTER, p, len); + transfer (BT_CHARACTER, p, len, 1); } void transfer_complex (void *p, int kind) { - g.item_count++; if (ioparm.library_return != LIBRARY_OK) return; - transfer (BT_COMPLEX, p, kind); + transfer (BT_COMPLEX, p, kind, 1); +} + + +void +transfer_array (gfc_array_char *desc, gfc_charlen_type charlen) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0, rank, size, type, n, kind; + size_t tsize; + char *data; + bt iotype; + + if (ioparm.library_return != LIBRARY_OK) + return; + + type = GFC_DESCRIPTOR_TYPE (desc); + size = GFC_DESCRIPTOR_SIZE (desc); + kind = size; + + /* FIXME: What a kludge: Array descriptors and the IO library use + different enums for types. */ + switch (type) + { + case GFC_DTYPE_UNKNOWN: + iotype = BT_NULL; /* Is this correct? */ + break; + case GFC_DTYPE_INTEGER: + iotype = BT_INTEGER; + break; + case GFC_DTYPE_LOGICAL: + iotype = BT_LOGICAL; + break; + case GFC_DTYPE_REAL: + iotype = BT_REAL; + break; + case GFC_DTYPE_COMPLEX: + iotype = BT_COMPLEX; + kind /= 2; + break; + case GFC_DTYPE_CHARACTER: + iotype = BT_CHARACTER; + /* FIXME: Currently dtype contains the charlen, which is + clobbered if charlen > 2**24. That's why we use a separate + argument for the charlen. However, if we want to support + non-8-bit charsets we need to fix dtype to contain + sizeof(chartype) and fix the code below. */ + size = charlen; + kind = charlen; + break; + case GFC_DTYPE_DERIVED: + internal_error ("Derived type I/O should have been handled via the frontend."); + break; + default: + internal_error ("transfer_array(): Bad type"); + } + + if (desc->dim[0].stride == 0) + desc->dim[0].stride = 1; + + rank = GFC_DESCRIPTOR_RANK (desc); + for (n = 0; n < rank; n++) + { + count[n] = 0; + stride[n] = desc->dim[n].stride; + extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound; + + /* If the extent of even one dimension is zero, then the entire + array section contains zero elements, so we return. */ + if (extent[n] == 0) + return; + } + + stride0 = stride[0]; + + /* If the innermost dimension has stride 1, we can do the transfer + in contiguous chunks. */ + if (stride0 == 1) + tsize = extent[0]; + else + tsize = 1; + + data = GFC_DESCRIPTOR_DATA (desc); + + while (data) + { + transfer (iotype, data, kind, tsize); + data += stride0 * size * tsize; + count[0] += tsize; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + data -= stride[n] * extent[n] * size; + n++; + if (n == rank) + { + data = NULL; + break; + } + else + { + count[n]++; + data += stride[n] * size; + } + } + } } @@ -1245,7 +1379,7 @@ data_transfer_init (int read_flag) /* Start the data transfer if we are doing a formatted transfer. */ if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format && ioparm.namelist_name == NULL && ionml == NULL) - formatted_transfer (0, NULL, 0); + formatted_transfer (0, NULL, 0, 1); } @@ -1568,15 +1702,15 @@ finalize_transfer (void) data transfer, it just updates the length counter. */ static void -iolength_transfer (bt type , void *dest __attribute__ ((unused)), - int len) +iolength_transfer (bt type, void *dest __attribute__ ((unused)), + int len, size_t nelems) { if (ioparm.iolength != NULL) { if (type == BT_COMPLEX) - *ioparm.iolength += 2*len; + *ioparm.iolength += 2 * len * nelems; else - *ioparm.iolength += len; + *ioparm.iolength += len * nelems; } } diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index da9feb3..0436134 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1423,8 +1423,8 @@ write_separator (void) TODO: handle skipping to the next record correctly, particularly with strings. */ -void -list_formatted_write (bt type, void *p, int len) +static void +list_formatted_write_scalar (bt type, void *p, int len) { static int char_flag; @@ -1468,6 +1468,29 @@ list_formatted_write (bt type, void *p, int len) char_flag = (type == BT_CHARACTER); } + +void +list_formatted_write (bt type, void *p, int len, size_t nelems) +{ + size_t elem; + int size; + char *tmp; + + tmp = (char *) p; + + if (type == BT_COMPLEX) + size = 2 * len; + else + size = len; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + g.item_count++; + list_formatted_write_scalar (type, tmp + size*elem, len); + } +} + /* NAMELIST OUTPUT nml_write_obj writes a namelist object to the output stream. It is called