123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571 |
- /* Copyright (C) 2018-2022 Free Software Foundation, Inc.
- Contributed by Nicolas Koenig
- This file is part of the GNU Fortran runtime library (libgfortran).
- Libgfortran is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 3, or (at your option)
- any later version.
- Libgfortran is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- Under Section 7 of GPL version 3, you are granted additional
- permissions described in the GCC Runtime Library Exception, version
- 3.1, as published by the Free Software Foundation.
- You should have received a copy of the GNU General Public License and
- a copy of the GCC Runtime Library Exception along with this program;
- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
- <http://www.gnu.org/licenses/>. */
- #include "libgfortran.h"
- #define _GTHREAD_USE_COND_INIT_FUNC
- #include "../../libgcc/gthr.h"
- #include "io.h"
- #include "fbuf.h"
- #include "format.h"
- #include "unix.h"
- #include <string.h>
- #include <assert.h>
- #include <sys/types.h>
- #include "async.h"
- #if ASYNC_IO
- DEBUG_LINE (__thread const char *aio_prefix = MPREFIX);
- DEBUG_LINE (__gthread_mutex_t debug_queue_lock = __GTHREAD_MUTEX_INIT;)
- DEBUG_LINE (aio_lock_debug *aio_debug_head = NULL;)
- /* Current unit for asynchronous I/O. Needed for error reporting. */
- __thread gfc_unit *thread_unit = NULL;
- /* Queue entry for the asynchronous I/O entry. */
- typedef struct transfer_queue
- {
- enum aio_do type;
- struct transfer_queue *next;
- struct st_parameter_dt *new_pdt;
- transfer_args arg;
- _Bool has_id;
- int read_flag;
- } transfer_queue;
- struct error {
- st_parameter_dt *dtp;
- int id;
- };
- /* Helper function to exchange the old vs. a new PDT. */
- static void
- update_pdt (st_parameter_dt **old, st_parameter_dt *new) {
- st_parameter_dt *temp;
- NOTE ("Changing pdts, current_unit = %p", (void *) (new->u.p.current_unit));
- temp = *old;
- *old = new;
- if (temp)
- free (temp);
- }
- /* Destroy an adv_cond structure. */
- static void
- destroy_adv_cond (struct adv_cond *ac)
- {
- T_ERROR (__gthread_cond_destroy, &ac->signal);
- }
- /* Function invoked as start routine for a new asynchronous I/O unit.
- Contains the main loop for accepting requests and handling them. */
- static void *
- async_io (void *arg)
- {
- DEBUG_LINE (aio_prefix = TPREFIX);
- transfer_queue *ctq = NULL, *prev = NULL;
- gfc_unit *u = (gfc_unit *) arg;
- async_unit *au = u->au;
- LOCK (&au->lock);
- thread_unit = u;
- au->thread = __gthread_self ();
- while (true)
- {
- /* Main loop. At this point, au->lock is always held. */
- WAIT_SIGNAL_MUTEX (&au->work, au->tail != NULL, &au->lock);
- LOCK (&au->lock);
- ctq = au->head;
- prev = NULL;
- /* Loop over the queue entries until they are finished. */
- while (ctq)
- {
- if (prev)
- free (prev);
- prev = ctq;
- if (!au->error.has_error)
- {
- UNLOCK (&au->lock);
- switch (ctq->type)
- {
- case AIO_WRITE_DONE:
- NOTE ("Finalizing write");
- st_write_done_worker (au->pdt, false);
- UNLOCK (&au->io_lock);
- break;
- case AIO_READ_DONE:
- NOTE ("Finalizing read");
- st_read_done_worker (au->pdt, false);
- UNLOCK (&au->io_lock);
- break;
- case AIO_DATA_TRANSFER_INIT:
- NOTE ("Data transfer init");
- LOCK (&au->io_lock);
- update_pdt (&au->pdt, ctq->new_pdt);
- data_transfer_init_worker (au->pdt, ctq->read_flag);
- break;
- case AIO_TRANSFER_SCALAR:
- NOTE ("Starting scalar transfer");
- ctq->arg.scalar.transfer (au->pdt, ctq->arg.scalar.arg_bt,
- ctq->arg.scalar.data,
- ctq->arg.scalar.i,
- ctq->arg.scalar.s1,
- ctq->arg.scalar.s2);
- break;
- case AIO_TRANSFER_ARRAY:
- NOTE ("Starting array transfer");
- NOTE ("ctq->arg.array.desc = %p",
- (void *) (ctq->arg.array.desc));
- transfer_array_inner (au->pdt, ctq->arg.array.desc,
- ctq->arg.array.kind,
- ctq->arg.array.charlen);
- free (ctq->arg.array.desc);
- break;
- case AIO_CLOSE:
- NOTE ("Received AIO_CLOSE");
- LOCK (&au->lock);
- goto finish_thread;
- default:
- internal_error (NULL, "Invalid queue type");
- break;
- }
- LOCK (&au->lock);
- if (unlikely (au->error.has_error))
- au->error.last_good_id = au->id.low - 1;
- }
- else
- {
- if (ctq->type == AIO_WRITE_DONE || ctq->type == AIO_READ_DONE)
- {
- UNLOCK (&au->io_lock);
- }
- else if (ctq->type == AIO_CLOSE)
- {
- NOTE ("Received AIO_CLOSE during error condition");
- goto finish_thread;
- }
- }
- NOTE ("Next ctq, current id: %d", au->id.low);
- if (ctq->has_id && au->id.waiting == au->id.low++)
- SIGNAL (&au->id.done);
- ctq = ctq->next;
- }
- au->tail = NULL;
- au->head = NULL;
- au->empty = 1;
- SIGNAL (&au->emptysignal);
- }
- finish_thread:
- au->tail = NULL;
- au->head = NULL;
- au->empty = 1;
- SIGNAL (&au->emptysignal);
- free (ctq);
- UNLOCK (&au->lock);
- return NULL;
- }
- /* Free an asynchronous unit. */
- static void
- free_async_unit (async_unit *au)
- {
- if (au->tail)
- internal_error (NULL, "Trying to free nonempty asynchronous unit");
- destroy_adv_cond (&au->work);
- destroy_adv_cond (&au->emptysignal);
- destroy_adv_cond (&au->id.done);
- T_ERROR (__gthread_mutex_destroy, &au->lock);
- free (au);
- }
- /* Initialize an adv_cond structure. */
- static void
- init_adv_cond (struct adv_cond *ac)
- {
- ac->pending = 0;
- __GTHREAD_COND_INIT_FUNCTION (&ac->signal);
- }
- /* Initialize an asyncronous unit, returning zero on success,
- nonzero on failure. It also sets u->au. */
- void
- init_async_unit (gfc_unit *u)
- {
- async_unit *au;
- if (!__gthread_active_p ())
- {
- u->au = NULL;
- return;
- }
-
- au = (async_unit *) xmalloc (sizeof (async_unit));
- u->au = au;
- init_adv_cond (&au->work);
- init_adv_cond (&au->emptysignal);
- __GTHREAD_MUTEX_INIT_FUNCTION (&au->lock);
- __GTHREAD_MUTEX_INIT_FUNCTION (&au->io_lock);
- LOCK (&au->lock);
- T_ERROR (__gthread_create, &au->thread, &async_io, (void *) u);
- au->pdt = NULL;
- au->head = NULL;
- au->tail = NULL;
- au->empty = true;
- au->id.waiting = -1;
- au->id.low = 0;
- au->id.high = 0;
- au->error.fatal_error = 0;
- au->error.has_error = 0;
- au->error.last_good_id = 0;
- init_adv_cond (&au->id.done);
- UNLOCK (&au->lock);
- }
- /* Enqueue a transfer statement. */
- void
- enqueue_transfer (async_unit *au, transfer_args *arg, enum aio_do type)
- {
- transfer_queue *tq = calloc (sizeof (transfer_queue), 1);
- tq->arg = *arg;
- tq->type = type;
- tq->has_id = 0;
- LOCK (&au->lock);
- if (!au->tail)
- au->head = tq;
- else
- au->tail->next = tq;
- au->tail = tq;
- REVOKE_SIGNAL (&(au->emptysignal));
- au->empty = false;
- SIGNAL (&au->work);
- UNLOCK (&au->lock);
- }
- /* Enqueue an st_write_done or st_read_done which contains an ID. */
- int
- enqueue_done_id (async_unit *au, enum aio_do type)
- {
- int ret;
- transfer_queue *tq = calloc (sizeof (transfer_queue), 1);
- tq->type = type;
- tq->has_id = 1;
- LOCK (&au->lock);
- if (!au->tail)
- au->head = tq;
- else
- au->tail->next = tq;
- au->tail = tq;
- REVOKE_SIGNAL (&(au->emptysignal));
- au->empty = false;
- ret = au->id.high++;
- NOTE ("Enqueue id: %d", ret);
- SIGNAL (&au->work);
- UNLOCK (&au->lock);
- return ret;
- }
- /* Enqueue an st_write_done or st_read_done without an ID. */
- void
- enqueue_done (async_unit *au, enum aio_do type)
- {
- transfer_queue *tq = calloc (sizeof (transfer_queue), 1);
- tq->type = type;
- tq->has_id = 0;
- LOCK (&au->lock);
- if (!au->tail)
- au->head = tq;
- else
- au->tail->next = tq;
- au->tail = tq;
- REVOKE_SIGNAL (&(au->emptysignal));
- au->empty = false;
- SIGNAL (&au->work);
- UNLOCK (&au->lock);
- }
- /* Enqueue a CLOSE statement. */
- void
- enqueue_close (async_unit *au)
- {
- transfer_queue *tq = calloc (sizeof (transfer_queue), 1);
- tq->type = AIO_CLOSE;
- LOCK (&au->lock);
- if (!au->tail)
- au->head = tq;
- else
- au->tail->next = tq;
- au->tail = tq;
- REVOKE_SIGNAL (&(au->emptysignal));
- au->empty = false;
- SIGNAL (&au->work);
- UNLOCK (&au->lock);
- }
- /* The asynchronous unit keeps the currently active PDT around.
- This function changes that to the current one. */
- void
- enqueue_data_transfer_init (async_unit *au, st_parameter_dt *dt, int read_flag)
- {
- st_parameter_dt *new = xmalloc (sizeof (st_parameter_dt));
- transfer_queue *tq = xmalloc (sizeof (transfer_queue));
- memcpy ((void *) new, (void *) dt, sizeof (st_parameter_dt));
- NOTE ("dt->internal_unit_desc = %p", dt->internal_unit_desc);
- NOTE ("common.flags & mask = %d", dt->common.flags & IOPARM_LIBRETURN_MASK);
- tq->next = NULL;
- tq->type = AIO_DATA_TRANSFER_INIT;
- tq->read_flag = read_flag;
- tq->has_id = 0;
- tq->new_pdt = new;
- LOCK (&au->lock);
- if (!au->tail)
- au->head = tq;
- else
- au->tail->next = tq;
- au->tail = tq;
- REVOKE_SIGNAL (&(au->emptysignal));
- au->empty = false;
- SIGNAL (&au->work);
- UNLOCK (&au->lock);
- }
- /* Collect the errors that may have happened asynchronously. Return true if
- an error has been encountered. */
- bool
- collect_async_errors (st_parameter_common *cmp, async_unit *au)
- {
- bool has_error = au->error.has_error;
- if (has_error)
- {
- if (generate_error_common (cmp, au->error.family, au->error.message))
- {
- au->error.has_error = 0;
- au->error.cmp = NULL;
- }
- else
- {
- /* The program will exit later. */
- au->error.fatal_error = true;
- }
- }
- return has_error;
- }
- /* Perform a wait operation on an asynchronous unit with an ID specified,
- which means collecting the errors that may have happened asynchronously.
- Return true if an error has been encountered. */
- bool
- async_wait_id (st_parameter_common *cmp, async_unit *au, int i)
- {
- bool ret;
- if (au == NULL)
- return false;
- if (cmp == NULL)
- cmp = au->error.cmp;
- if (au->error.has_error)
- {
- if (i <= au->error.last_good_id)
- return false;
- return collect_async_errors (cmp, au);
- }
- LOCK (&au->lock);
- if (i > au->id.high)
- {
- generate_error_common (cmp, LIBERROR_BAD_WAIT_ID, NULL);
- UNLOCK (&au->lock);
- return true;
- }
- NOTE ("Waiting for id %d", i);
- if (au->id.waiting < i)
- au->id.waiting = i;
- SIGNAL (&(au->work));
- WAIT_SIGNAL_MUTEX (&(au->id.done),
- (au->id.low >= au->id.waiting || au->empty), &au->lock);
- LOCK (&au->lock);
- ret = collect_async_errors (cmp, au);
- UNLOCK (&au->lock);
- return ret;
- }
- /* Perform a wait operation an an asynchronous unit without an ID. */
- bool
- async_wait (st_parameter_common *cmp, async_unit *au)
- {
- bool ret;
- if (au == NULL)
- return false;
- if (cmp == NULL)
- cmp = au->error.cmp;
- LOCK (&(au->lock));
- SIGNAL (&(au->work));
- if (au->empty)
- {
- ret = collect_async_errors (cmp, au);
- UNLOCK (&au->lock);
- return ret;
- }
- WAIT_SIGNAL_MUTEX (&(au->emptysignal), (au->empty), &au->lock);
- ret = collect_async_errors (cmp, au);
- return ret;
- }
- /* Close an asynchronous unit. */
- void
- async_close (async_unit *au)
- {
- if (au == NULL)
- return;
- NOTE ("Closing async unit");
- enqueue_close (au);
- T_ERROR (__gthread_join, au->thread, NULL);
- free_async_unit (au);
- }
- #else
- /* Only set u->au to NULL so no async I/O will happen. */
- void
- init_async_unit (gfc_unit *u)
- {
- u->au = NULL;
- return;
- }
- /* Do-nothing function, which will not be called. */
- void
- enqueue_transfer (async_unit *au, transfer_args *arg, enum aio_do type)
- {
- return;
- }
- /* Do-nothing function, which will not be called. */
- int
- enqueue_done_id (async_unit *au, enum aio_do type)
- {
- return 0;
- }
- /* Do-nothing function, which will not be called. */
- void
- enqueue_done (async_unit *au, enum aio_do type)
- {
- return;
- }
- /* Do-nothing function, which will not be called. */
- void
- enqueue_close (async_unit *au)
- {
- return;
- }
- /* Do-nothing function, which will not be called. */
- void
- enqueue_data_transfer_init (async_unit *au, st_parameter_dt *dt, int read_flag)
- {
- return;
- }
- /* Do-nothing function, which will not be called. */
- bool
- collect_async_errors (st_parameter_common *cmp, async_unit *au)
- {
- return false;
- }
- /* Do-nothing function, which will not be called. */
- bool
- async_wait_id (st_parameter_common *cmp, async_unit *au, int i)
- {
- return false;
- }
- /* Do-nothing function, which will not be called. */
- bool
- async_wait (st_parameter_common *cmp, async_unit *au)
- {
- return false;
- }
- /* Do-nothing function, which will not be called. */
- void
- async_close (async_unit *au)
- {
- return;
- }
- #endif
|