Fix deadlock (#10545)
authorSimon Marlow <marlowsd@gmail.com>
Fri, 19 Jun 2015 14:12:24 +0000 (15:12 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 26 Jun 2015 08:32:23 +0000 (09:32 +0100)
yieldCapability() was not prepared to be called by a Task that is not
either a worker or a bound Task.  This could happen if we ended up in
yieldCapability via this call stack:

performGC()
scheduleDoGC()
requestSync()
yieldCapability()

and there were a few other ways this could happen via requestSync.
The fix is to handle this case in yieldCapability(): when the Task is
not a worker or a bound Task, we put it on the returning_workers
queue, where it will be woken up again.

Summary of changes:

* `yieldCapability`: factored out subroutine waitForWorkerCapability`
* `waitForReturnCapability` renamed to `waitForCapability`, and
  factored out subroutine `waitForReturnCapability`
* `releaseCapabilityAndQueue` worker renamed to `enqueueWorker`, does
  not take a lock and no longer tests if `!isBoundTask()`
* `yieldCapability` adjusted for refactorings, only change in behavior
  is when it is not a worker or bound task.

Test Plan:
* new test concurrent/should_run/performGC
* validate

Reviewers: niteria, austin, ezyang, bgamari

Subscribers: thomie, bgamari

Differential Revision: https://phabricator.haskell.org/D997

GHC Trac Issues: #10545

rts/Capability.c
rts/Capability.h
rts/RtsAPI.c
rts/Schedule.c
rts/Task.h
testsuite/tests/concurrent/should_run/RandomPGC.hs [new file with mode: 0644]
testsuite/tests/concurrent/should_run/all.T
testsuite/tests/concurrent/should_run/performGC.hs [new file with mode: 0644]
testsuite/tests/concurrent/should_run/performGC.stdout [new file with mode: 0644]

index 21f63f3..b0b7f30 100644 (file)
@@ -43,7 +43,7 @@ nat enabled_capabilities = 0;
 // The array of Capabilities.  It's important that when we need
 // to allocate more Capabilities we don't have to move the existing
 // Capabilities, because there may be pointers to them in use
-// (e.g. threads in waitForReturnCapability(), see #8209), so this is
+// (e.g. threads in waitForCapability(), see #8209), so this is
 // an array of Capability* rather than an array of Capability.
 Capability **capabilities = NULL;
 
@@ -450,11 +450,10 @@ giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task)
 #endif
 
 /* ----------------------------------------------------------------------------
- * Function:  releaseCapability(Capability*)
+ * releaseCapability
  *
- * Purpose:   Letting go of a capability. Causes a
- *            'returning worker' thread or a 'waiting worker'
- *            to wake up, in that order.
+ * The current Task (cap->task) releases the Capability.  The Capability is
+ * marked free, and if there is any work to do, an appropriate Task is woken up.
  * ------------------------------------------------------------------------- */
 
 #if defined(THREADED_RTS)
@@ -474,13 +473,13 @@ releaseCapability_ (Capability* cap,
     // the go-ahead to return the result of an external call..
     if (cap->returning_tasks_hd != NULL) {
         giveCapabilityToTask(cap,cap->returning_tasks_hd);
-        // The Task pops itself from the queue (see waitForReturnCapability())
+        // The Task pops itself from the queue (see waitForCapability())
         return;
     }
 
     // If there is a pending sync, then we should just leave the
     // Capability free.  The thread trying to sync will be about to
-    // call waitForReturnCapability().
+    // call waitForCapability().
     if (pending_sync != 0 && pending_sync != SYNC_GC_PAR) {
       last_free_capability = cap; // needed?
       debugTrace(DEBUG_sched, "sync pending, set capability %d free", cap->no);
@@ -549,62 +548,156 @@ releaseAndWakeupCapability (Capability* cap USED_IF_THREADS)
 }
 
 static void
-releaseCapabilityAndQueueWorker (Capability* cap USED_IF_THREADS)
+enqueueWorker (Capability* cap USED_IF_THREADS)
 {
     Task *task;
 
-    ACQUIRE_LOCK(&cap->lock);
-
     task = cap->running_task;
 
     // If the Task is stopped, we shouldn't be yielding, we should
     // be just exiting.
     ASSERT(!task->stopped);
+    ASSERT(task->worker);
 
-    // If the current task is a worker, save it on the spare_workers
-    // list of this Capability.  A worker can mark itself as stopped,
-    // in which case it is not replaced on the spare_worker queue.
-    // This happens when the system is shutting down (see
-    // Schedule.c:workerStart()).
-    if (!isBoundTask(task))
+    if (cap->n_spare_workers < MAX_SPARE_WORKERS)
+    {
+        task->next = cap->spare_workers;
+        cap->spare_workers = task;
+        cap->n_spare_workers++;
+    }
+    else
     {
-        if (cap->n_spare_workers < MAX_SPARE_WORKERS)
-        {
-            task->next = cap->spare_workers;
-            cap->spare_workers = task;
-            cap->n_spare_workers++;
+        debugTrace(DEBUG_sched, "%d spare workers already, exiting",
+                   cap->n_spare_workers);
+        releaseCapability_(cap,rtsFalse);
+        // hold the lock until after workerTaskStop; c.f. scheduleWorker()
+        workerTaskStop(task);
+        RELEASE_LOCK(&cap->lock);
+        shutdownThread();
+    }
+}
+
+#endif
+
+/* ----------------------------------------------------------------------------
+ * waitForWorkerCapability(task)
+ *
+ * waits to be given a Capability, and then returns the Capability.  The task
+ * must be either a worker (and on a cap->spare_workers queue), or a bound Task.
+ * ------------------------------------------------------------------------- */
+
+#if defined(THREADED_RTS)
+
+static Capability * waitForWorkerCapability (Task *task)
+{
+    Capability *cap;
+
+    for (;;) {
+        ACQUIRE_LOCK(&task->lock);
+        // task->lock held, cap->lock not held
+        if (!task->wakeup) waitCondition(&task->cond, &task->lock);
+        cap = task->cap;
+        task->wakeup = rtsFalse;
+        RELEASE_LOCK(&task->lock);
+
+        debugTrace(DEBUG_sched, "woken up on capability %d", cap->no);
+
+        ACQUIRE_LOCK(&cap->lock);
+        if (cap->running_task != NULL) {
+            debugTrace(DEBUG_sched,
+                       "capability %d is owned by another task", cap->no);
+            RELEASE_LOCK(&cap->lock);
+            continue;
         }
-        else
-        {
-            debugTrace(DEBUG_sched, "%d spare workers already, exiting",
-                       cap->n_spare_workers);
-            releaseCapability_(cap,rtsFalse);
-            // hold the lock until after workerTaskStop; c.f. scheduleWorker()
-            workerTaskStop(task);
+
+        if (task->cap != cap) {
+            // see Note [migrated bound threads]
+            debugTrace(DEBUG_sched,
+                       "task has been migrated to cap %d", task->cap->no);
             RELEASE_LOCK(&cap->lock);
-            shutdownThread();
+            continue;
+        }
+
+        if (task->incall->tso == NULL) {
+            ASSERT(cap->spare_workers != NULL);
+            // if we're not at the front of the queue, release it
+                // again.  This is unlikely to happen.
+            if (cap->spare_workers != task) {
+                giveCapabilityToTask(cap,cap->spare_workers);
+                RELEASE_LOCK(&cap->lock);
+                continue;
+            }
+            cap->spare_workers = task->next;
+            task->next = NULL;
+            cap->n_spare_workers--;
         }
+
+        cap->running_task = task;
+        RELEASE_LOCK(&cap->lock);
+        break;
     }
-    // Bound tasks just float around attached to their TSOs.
 
-    releaseCapability_(cap,rtsFalse);
+    return cap;
+}
 
-    RELEASE_LOCK(&cap->lock);
+#endif /* THREADED_RTS */
+
+/* ----------------------------------------------------------------------------
+ * waitForReturnCapability (Task *task)
+ *
+ * The Task should be on the cap->returning_tasks queue of a Capability.  This
+ * function waits for the Task to be woken up, and returns the Capability that
+ * it was woken up on.
+ *
+ * ------------------------------------------------------------------------- */
+
+#if defined(THREADED_RTS)
+
+static Capability * waitForReturnCapability (Task *task)
+{
+    Capability *cap;
+
+    for (;;) {
+        ACQUIRE_LOCK(&task->lock);
+        // task->lock held, cap->lock not held
+        if (!task->wakeup) waitCondition(&task->cond, &task->lock);
+        cap = task->cap;
+        task->wakeup = rtsFalse;
+        RELEASE_LOCK(&task->lock);
+
+        // now check whether we should wake up...
+        ACQUIRE_LOCK(&cap->lock);
+        if (cap->running_task == NULL) {
+            if (cap->returning_tasks_hd != task) {
+                giveCapabilityToTask(cap,cap->returning_tasks_hd);
+                RELEASE_LOCK(&cap->lock);
+                continue;
+            }
+            cap->running_task = task;
+            popReturningTask(cap);
+            RELEASE_LOCK(&cap->lock);
+            break;
+        }
+        RELEASE_LOCK(&cap->lock);
+    }
+
+    return cap;
 }
-#endif
+
+#endif /* THREADED_RTS */
 
 /* ----------------------------------------------------------------------------
- * waitForReturnCapability (Capability **pCap, Task *task)
+ * waitForCapability (Capability **pCap, Task *task)
  *
  * Purpose:  when an OS thread returns from an external call,
- * it calls waitForReturnCapability() (via Schedule.resumeThread())
+ * it calls waitForCapability() (via Schedule.resumeThread())
  * to wait for permission to enter the RTS & communicate the
  * result of the external call back to the Haskell thread that
  * made it.
  *
  * ------------------------------------------------------------------------- */
-void
-waitForReturnCapability (Capability **pCap, Task *task)
+
+void waitForCapability (Capability **pCap, Task *task)
 {
 #if !defined(THREADED_RTS)
 
@@ -641,10 +734,9 @@ waitForReturnCapability (Capability **pCap, Task *task)
         ASSERT(task->cap == cap);
     }
 
-    ACQUIRE_LOCK(&cap->lock);
-
     debugTrace(DEBUG_sched, "returning; I want capability %d", cap->no);
 
+    ACQUIRE_LOCK(&cap->lock);
     if (!cap->running_task) {
         // It's free; just grab it
         cap->running_task = task;
@@ -652,31 +744,7 @@ waitForReturnCapability (Capability **pCap, Task *task)
     } else {
         newReturningTask(cap,task);
         RELEASE_LOCK(&cap->lock);
-
-        for (;;) {
-            ACQUIRE_LOCK(&task->lock);
-            // task->lock held, cap->lock not held
-            if (!task->wakeup) waitCondition(&task->cond, &task->lock);
-            cap = task->cap;
-            task->wakeup = rtsFalse;
-            RELEASE_LOCK(&task->lock);
-
-            // now check whether we should wake up...
-            ACQUIRE_LOCK(&cap->lock);
-            if (cap->running_task == NULL) {
-                if (cap->returning_tasks_hd != task) {
-                    giveCapabilityToTask(cap,cap->returning_tasks_hd);
-                    RELEASE_LOCK(&cap->lock);
-                    continue;
-                }
-                cap->running_task = task;
-                popReturningTask(cap);
-                RELEASE_LOCK(&cap->lock);
-                break;
-            }
-            RELEASE_LOCK(&cap->lock);
-        }
-
+        cap = waitForReturnCapability(task);
     }
 
 #ifdef PROFILING
@@ -691,11 +759,30 @@ waitForReturnCapability (Capability **pCap, Task *task)
 #endif
 }
 
-#if defined(THREADED_RTS)
 /* ----------------------------------------------------------------------------
  * yieldCapability
+ *
+ * Give up the Capability, and return when we have it again.  This is called
+ * when either we know that the Capability should be given to another Task, or
+ * there is nothing to do right now.  One of the following is true:
+ *
+ *    - The current Task is a worker, and there's a bound thread at the head of
+ *      the run queue (or vice versa)
+ *
+ *    - The run queue is empty.  We'll be woken up again when there's work to
+ *      do.
+ *
+ *    - Another Task is trying to do parallel GC (pending_sync == SYNC_GC_PAR).
+ *      We should become a GC worker for a while.
+ *
+ *    - Another Task is trying to acquire all the Capabilities (pending_sync !=
+ *      SYNC_GC_PAR), either to do a sequential GC, forkProcess, or
+ *      setNumCapabilities.  We should give up the Capability temporarily.
+ *
  * ------------------------------------------------------------------------- */
 
+#if defined (THREADED_RTS)
+
 /* See Note [GC livelock] in Schedule.c for why we have gcAllowed
    and return the rtsBool */
 rtsBool /* Did we GC? */
@@ -714,63 +801,39 @@ yieldCapability (Capability** pCap, Task *task, rtsBool gcAllowed)
         }
     }
 
-        debugTrace(DEBUG_sched, "giving up capability %d", cap->no);
+    debugTrace(DEBUG_sched, "giving up capability %d", cap->no);
 
-        // We must now release the capability and wait to be woken up
-        // again.
-        task->wakeup = rtsFalse;
-        releaseCapabilityAndQueueWorker(cap);
-
-        for (;;) {
-            ACQUIRE_LOCK(&task->lock);
-            // task->lock held, cap->lock not held
-            if (!task->wakeup) waitCondition(&task->cond, &task->lock);
-            cap = task->cap;
-            task->wakeup = rtsFalse;
-            RELEASE_LOCK(&task->lock);
-
-            debugTrace(DEBUG_sched, "woken up on capability %d", cap->no);
-
-            ACQUIRE_LOCK(&cap->lock);
-            if (cap->running_task != NULL) {
-                debugTrace(DEBUG_sched,
-                           "capability %d is owned by another task", cap->no);
-                RELEASE_LOCK(&cap->lock);
-                continue;
-            }
+    // We must now release the capability and wait to be woken up again.
+    task->wakeup = rtsFalse;
 
-            if (task->cap != cap) {
-                // see Note [migrated bound threads]
-                debugTrace(DEBUG_sched,
-                           "task has been migrated to cap %d", task->cap->no);
-                RELEASE_LOCK(&cap->lock);
-                continue;
-            }
+    ACQUIRE_LOCK(&cap->lock);
 
-            if (task->incall->tso == NULL) {
-                ASSERT(cap->spare_workers != NULL);
-                // if we're not at the front of the queue, release it
-                // again.  This is unlikely to happen.
-                if (cap->spare_workers != task) {
-                    giveCapabilityToTask(cap,cap->spare_workers);
-                    RELEASE_LOCK(&cap->lock);
-                    continue;
-                }
-                cap->spare_workers = task->next;
-                task->next = NULL;
-                cap->n_spare_workers--;
-            }
+    // If this is a worker thread, put it on the spare_workers queue
+    if (isWorker(task)) {
+        enqueueWorker(cap);
+    }
 
-            cap->running_task = task;
-            RELEASE_LOCK(&cap->lock);
-            break;
-        }
+    releaseCapability_(cap, rtsFalse);
 
-        debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
-        ASSERT(cap->running_task == task);
+    if (isWorker(task) || isBoundTask(task)) {
+        RELEASE_LOCK(&cap->lock);
+        cap = waitForWorkerCapability(task);
+    } else {
+        // Not a worker Task, or a bound Task.  The only way we can be woken up
+        // again is to put ourselves on the returning_tasks queue, so that's
+        // what we do.  We still hold cap->lock at this point
+        // The Task waiting for this Capability does not have it
+        // yet, so we can be sure to be woken up later. (see #10545)
+        newReturningTask(cap,task);
+        RELEASE_LOCK(&cap->lock);
+        cap = waitForReturnCapability(task);
+    }
+
+    debugTrace(DEBUG_sched, "resuming capability %d", cap->no);
+    ASSERT(cap->running_task == task);
 
 #ifdef PROFILING
-        cap->r.rCCCS = CCS_SYSTEM;
+    cap->r.rCCCS = CCS_SYSTEM;
 #endif
 
     *pCap = cap;
@@ -780,6 +843,8 @@ yieldCapability (Capability** pCap, Task *task, rtsBool gcAllowed)
     return rtsFalse;
 }
 
+#endif /* THREADED_RTS */
+
 // Note [migrated bound threads]
 //
 // There's a tricky case where:
@@ -815,6 +880,8 @@ yieldCapability (Capability** pCap, Task *task, rtsBool gcAllowed)
  * get every Capability into the GC.
  * ------------------------------------------------------------------------- */
 
+#if defined (THREADED_RTS)
+
 void
 prodCapability (Capability *cap, Task *task)
 {
@@ -826,6 +893,8 @@ prodCapability (Capability *cap, Task *task)
     RELEASE_LOCK(&cap->lock);
 }
 
+#endif /* THREADED_RTS */
+
 /* ----------------------------------------------------------------------------
  * tryGrabCapability
  *
@@ -833,6 +902,8 @@ prodCapability (Capability *cap, Task *task)
  *
  * ------------------------------------------------------------------------- */
 
+#if defined (THREADED_RTS)
+
 rtsBool
 tryGrabCapability (Capability *cap, Task *task)
 {
index 420bfd5..fb9f0aa 100644 (file)
@@ -248,7 +248,7 @@ extern volatile StgWord pending_sync;
 //
 // On return, *cap is non-NULL, and points to the Capability acquired.
 //
-void waitForReturnCapability (Capability **cap/*in/out*/, Task *task);
+void waitForCapability (Capability **cap/*in/out*/, Task *task);
 
 EXTERN_INLINE void recordMutableCap (StgClosure *p, Capability *cap, nat gen);
 
@@ -269,12 +269,6 @@ EXTERN_INLINE void recordClosureMutated (Capability *cap, StgClosure *p);
 //
 rtsBool yieldCapability (Capability** pCap, Task *task, rtsBool gcAllowed);
 
-// Acquires a capability for doing some work.
-//
-// On return: pCap points to the capability.
-//
-void waitForCapability (Task *task, Mutex *mutex, Capability **pCap);
-
 // Wakes up a worker thread on just one Capability, used when we
 // need to service some global event.
 //
index fb91faf..2b3ad74 100644 (file)
@@ -564,7 +564,7 @@ rts_lock (void)
     }
 
     cap = NULL;
-    waitForReturnCapability(&cap, task);
+    waitForCapability(&cap, task);
 
     if (task->incall->prev_stack == NULL) {
       // This is a new outermost call from C into Haskell land.
index f81fc0e..6edb7d0 100644 (file)
@@ -1424,7 +1424,7 @@ static void acquireAllCapabilities(Capability *cap, Task *task)
             // all the Capabilities, but even so it's a slightly
             // unsavoury invariant.
             task->cap = tmpcap;
-            waitForReturnCapability(&tmpcap, task);
+            waitForCapability(&tmpcap, task);
             if (tmpcap->no != i) {
                 barf("acquireAllCapabilities: got the wrong capability");
             }
@@ -1801,7 +1801,7 @@ forkProcess(HsStablePtr *entry
     task = newBoundTask();
 
     cap = NULL;
-    waitForReturnCapability(&cap, task);
+    waitForCapability(&cap, task);
 
 #ifdef THREADED_RTS
     do {
@@ -2278,7 +2278,7 @@ resumeThread (void *task_)
     task->cap = cap;
 
     // Wait for permission to re-enter the RTS with the result.
-    waitForReturnCapability(&cap,task);
+    waitForCapability(&cap,task);
     // we might be on a different capability now... but if so, our
     // entry on the suspended_ccalls list will also have been
     // migrated.
@@ -2408,7 +2408,7 @@ void scheduleWorker (Capability *cap, Task *task)
     // cap->lock until we've finished workerTaskStop() below.
     //
     // There may be workers still involved in foreign calls; those
-    // will just block in waitForReturnCapability() because the
+    // will just block in waitForCapability() because the
     // Capability has been shut down.
     //
     ACQUIRE_LOCK(&cap->lock);
@@ -2499,7 +2499,7 @@ exitScheduler (rtsBool wait_foreign USED_IF_THREADS)
     if (sched_state < SCHED_SHUTTING_DOWN) {
         sched_state = SCHED_INTERRUPTING;
         Capability *cap = task->cap;
-        waitForReturnCapability(&cap,task);
+        waitForCapability(&cap,task);
         scheduleDoGC(&cap,task,rtsTrue);
         ASSERT(task->incall->tso == NULL);
         releaseCapability(cap);
@@ -2523,7 +2523,7 @@ freeScheduler( void )
     still_running = freeTaskManager();
     // We can only free the Capabilities if there are no Tasks still
     // running.  We might have a Task about to return from a foreign
-    // call into waitForReturnCapability(), for example (actually,
+    // call into waitForCapability(), for example (actually,
     // this should be the *only* thing that a still-running Task can
     // do at this point, and it will block waiting for the
     // Capability).
@@ -2567,7 +2567,7 @@ performGC_(rtsBool force_major)
 
     // TODO: do we need to traceTask*() here?
 
-    waitForReturnCapability(&cap,task);
+    waitForCapability(&cap,task);
     scheduleDoGC(&cap,task,force_major);
     releaseCapability(cap);
     boundTaskExiting(task);
index 5c7b049..58798bd 100644 (file)
@@ -167,6 +167,17 @@ isBoundTask (Task *task)
     return (task->incall->tso != NULL);
 }
 
+// A Task is currently a worker if
+//  (a) it was created as a worker (task->worker), and
+//  (b) it has not left and re-entered Haskell, in which case
+//      task->incall->prev_stack would be non-NULL.
+//
+INLINE_HEADER rtsBool
+isWorker (Task *task)
+{
+    return (task->worker && task->incall->prev_stack == NULL);
+}
+
 // Linked list of all tasks.
 //
 extern Task *all_tasks;
diff --git a/testsuite/tests/concurrent/should_run/RandomPGC.hs b/testsuite/tests/concurrent/should_run/RandomPGC.hs
new file mode 100644 (file)
index 0000000..df4c58d
--- /dev/null
@@ -0,0 +1,597 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Random
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file LICENSE in the 'random' repository)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- This library deals with the common task of pseudo-random number
+-- generation. The library makes it possible to generate repeatable
+-- results, by starting with a specified initial random number generator,
+-- or to get different results on each run by using the system-initialised
+-- generator or by supplying a seed from some other source.
+--
+-- The library is split into two layers:
+--
+-- * A core /random number generator/ provides a supply of bits.
+--   The class 'RandomGen' provides a common interface to such generators.
+--   The library provides one instance of 'RandomGen', the abstract
+--   data type 'StdGen'.  Programmers may, of course, supply their own
+--   instances of 'RandomGen'.
+--
+-- * The class 'Random' provides a way to extract values of a particular
+--   type from a random number generator.  For example, the 'Float'
+--   instance of 'Random' allows one to generate random values of type
+--   'Float'.
+--
+-- This implementation uses the Portable Combined Generator of L'Ecuyer
+-- ["System.Random\#LEcuyer"] for 32-bit computers, transliterated by
+-- Lennart Augustsson.  It has a period of roughly 2.30584e18.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module RandomPGC
+        (
+
+        -- $intro
+
+        -- * Random number generators
+
+#ifdef ENABLE_SPLITTABLEGEN
+          RandomGen(next, genRange)
+        , SplittableGen(split)
+#else
+          RandomGen(next, genRange, split)
+#endif
+        -- ** Standard random number generators
+        , StdGen
+        , mkStdGen
+
+        -- ** The global random number generator
+
+        -- $globalrng
+
+        , getStdRandom
+        , getStdGen
+        , setStdGen
+        , newStdGen
+
+        -- * Random values of various types
+        , Random ( random,   randomR,
+                   randoms,  randomRs,
+                   randomIO, randomRIO )
+
+        -- * References
+        -- $references
+
+        ) where
+
+import Prelude
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Foreign.C.Types
+
+#ifdef __NHC__
+import CPUTime          ( getCPUTime )
+import Foreign.Ptr      ( Ptr, nullPtr )
+import Foreign.C        ( CTime, CUInt )
+#else
+import System.CPUTime   ( getCPUTime )
+import Data.Time        ( getCurrentTime, UTCTime(..) )
+import Data.Ratio       ( numerator, denominator )
+#endif
+import Data.Char        ( isSpace, chr, ord )
+import System.IO.Unsafe ( unsafePerformIO )
+import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef       ( atomicModifyIORef' )
+import Numeric          ( readDec )
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts         ( build )
+#else
+-- | A dummy variant of build without fusion.
+{-# INLINE build #-}
+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
+build g = g (:) []
+#endif
+
+-- The standard nhc98 implementation of Time.ClockTime does not match
+-- the extended one expected in this module, so we lash-up a quick
+-- replacement here.
+#ifdef __NHC__
+foreign import ccall "time.h time" readtime :: Ptr CTime -> IO CTime
+getTime :: IO (Integer, Integer)
+getTime = do CTime t <- readtime nullPtr;  return (toInteger t, 0)
+#else
+getTime :: IO (Integer, Integer)
+getTime = do
+  utc <- getCurrentTime
+  let daytime = toRational $ utctDayTime utc
+  return $ quotRem (numerator daytime) (denominator daytime)
+#endif
+
+-- | The class 'RandomGen' provides a common interface to random number
+-- generators.
+--
+#ifdef ENABLE_SPLITTABLEGEN
+-- Minimal complete definition: 'next'.
+#else
+-- Minimal complete definition: 'next' and 'split'.
+#endif
+
+class RandomGen g where
+
+   -- |The 'next' operation returns an 'Int' that is uniformly distributed
+   -- in the range returned by 'genRange' (including both end points),
+   -- and a new generator.
+   next     :: g -> (Int, g)
+
+   -- |The 'genRange' operation yields the range of values returned by
+   -- the generator.
+   --
+   -- It is required that:
+   --
+   -- * If @(a,b) = 'genRange' g@, then @a < b@.
+   --
+   -- * 'genRange' always returns a pair of defined 'Int's.
+   --
+   -- The second condition ensures that 'genRange' cannot examine its
+   -- argument, and hence the value it returns can be determined only by the
+   -- instance of 'RandomGen'.  That in turn allows an implementation to make
+   -- a single call to 'genRange' to establish a generator's range, without
+   -- being concerned that the generator returned by (say) 'next' might have
+   -- a different range to the generator passed to 'next'.
+   --
+   -- The default definition spans the full range of 'Int'.
+   genRange :: g -> (Int,Int)
+
+   -- default method
+   genRange _ = (minBound, maxBound)
+
+#ifdef ENABLE_SPLITTABLEGEN
+-- | The class 'SplittableGen' proivides a way to specify a random number
+--   generator that can be split into two new generators.
+class SplittableGen g where
+#endif
+   -- |The 'split' operation allows one to obtain two distinct random number
+   -- generators. This is very useful in functional programs (for example, when
+   -- passing a random number generator down to recursive calls), but very
+   -- little work has been done on statistically robust implementations of
+   -- 'split' (["System.Random\#Burton", "System.Random\#Hellekalek"]
+   -- are the only examples we know of).
+   split    :: g -> (g, g)
+
+{- |
+The 'StdGen' instance of 'RandomGen' has a 'genRange' of at least 30 bits.
+
+The result of repeatedly using 'next' should be at least as statistically
+robust as the /Minimal Standard Random Number Generator/ described by
+["System.Random\#Park", "System.Random\#Carta"].
+Until more is known about implementations of 'split', all we require is
+that 'split' deliver generators that are (a) not identical and
+(b) independently robust in the sense just given.
+
+The 'Show' and 'Read' instances of 'StdGen' provide a primitive way to save the
+state of a random number generator.
+It is required that @'read' ('show' g) == g@.
+
+In addition, 'reads' may be used to map an arbitrary string (not necessarily one
+produced by 'show') onto a value of type 'StdGen'. In general, the 'Read'
+instance of 'StdGen' has the following properties:
+
+* It guarantees to succeed on any string.
+
+* It guarantees to consume only a finite portion of the string.
+
+* Different argument strings are likely to result in different results.
+
+-}
+
+data StdGen
+ = StdGen !Int32 !Int32
+
+instance RandomGen StdGen where
+  next  = stdNext
+  genRange _ = stdRange
+
+#ifdef ENABLE_SPLITTABLEGEN
+instance SplittableGen StdGen where
+#endif
+  split = stdSplit
+
+instance Show StdGen where
+  showsPrec p (StdGen s1 s2) =
+     showsPrec p s1 .
+     showChar ' ' .
+     showsPrec p s2
+
+instance Read StdGen where
+  readsPrec _p = \ r ->
+     case try_read r of
+       r'@[_] -> r'
+       _   -> [stdFromString r] -- because it shouldn't ever fail.
+    where
+      try_read r = do
+         (s1, r1) <- readDec (dropWhile isSpace r)
+         (s2, r2) <- readDec (dropWhile isSpace r1)
+         return (StdGen s1 s2, r2)
+
+{-
+ If we cannot unravel the StdGen from a string, create
+ one based on the string given.
+-}
+stdFromString         :: String -> (StdGen, String)
+stdFromString s        = (mkStdGen num, rest)
+        where (cs, rest) = splitAt 6 s
+              num        = foldl (\a x -> x + 3 * a) 1 (map ord cs)
+
+
+{- |
+The function 'mkStdGen' provides an alternative way of producing an initial
+generator, by mapping an 'Int' into a generator. Again, distinct arguments
+should be likely to produce distinct generators.
+-}
+mkStdGen :: Int -> StdGen -- why not Integer ?
+mkStdGen s = mkStdGen32 $ fromIntegral s
+
+{-
+From ["System.Random\#LEcuyer"]: "The integer variables s1 and s2 ... must be
+initialized to values in the range [1, 2147483562] and [1, 2147483398]
+respectively."
+-}
+mkStdGen32 :: Int32 -> StdGen
+mkStdGen32 sMaybeNegative = StdGen (s1+1) (s2+1)
+      where
+        -- We want a non-negative number, but we can't just take the abs
+        -- of sMaybeNegative as -minBound == minBound.
+        s       = sMaybeNegative .&. maxBound
+        (q, s1) = s `divMod` 2147483562
+        s2      = q `mod` 2147483398
+
+createStdGen :: Integer -> StdGen
+createStdGen s = mkStdGen32 $ fromIntegral s
+
+{- |
+With a source of random number supply in hand, the 'Random' class allows the
+programmer to extract random values of a variety of types.
+
+Minimal complete definition: 'randomR' and 'random'.
+
+-}
+
+class Random a where
+  -- | Takes a range /(lo,hi)/ and a random number generator
+  -- /g/, and returns a random value uniformly distributed in the closed
+  -- interval /[lo,hi]/, together with a new generator. It is unspecified
+  -- what happens if /lo>hi/. For continuous types there is no requirement
+  -- that the values /lo/ and /hi/ are ever produced, but they may be,
+  -- depending on the implementation and the interval.
+  randomR :: RandomGen g => (a,a) -> g -> (a,g)
+
+  -- | The same as 'randomR', but using a default range determined by the type:
+  --
+  -- * For bounded types (instances of 'Bounded', such as 'Char'),
+  --   the range is normally the whole type.
+  --
+  -- * For fractional types, the range is normally the semi-closed interval
+  -- @[0,1)@.
+  --
+  -- * For 'Integer', the range is (arbitrarily) the range of 'Int'.
+  random  :: RandomGen g => g -> (a, g)
+
+  -- | Plural variant of 'randomR', producing an infinite list of
+  -- random values instead of returning a new generator.
+  {-# INLINE randomRs #-}
+  randomRs :: RandomGen g => (a,a) -> g -> [a]
+  randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g)
+
+  -- | Plural variant of 'random', producing an infinite list of
+  -- random values instead of returning a new generator.
+  {-# INLINE randoms #-}
+  randoms  :: RandomGen g => g -> [a]
+  randoms  g      = build (\cons _nil -> buildRandoms cons random g)
+
+  -- | A variant of 'randomR' that uses the global random number generator
+  -- (see "System.Random#globalrng").
+  randomRIO :: (a,a) -> IO a
+  randomRIO range  = getStdRandom (randomR range)
+
+  -- | A variant of 'random' that uses the global random number generator
+  -- (see "System.Random#globalrng").
+  randomIO  :: IO a
+  randomIO         = getStdRandom random
+
+-- | Produce an infinite list-equivalent of random values.
+{-# INLINE buildRandoms #-}
+buildRandoms :: RandomGen g
+             => (a -> as -> as)  -- ^ E.g. '(:)' but subject to fusion
+             -> (g -> (a,g))     -- ^ E.g. 'random'
+             -> g                -- ^ A 'RandomGen' instance
+             -> as
+buildRandoms cons rand = go
+  where
+    -- The seq fixes part of #4218 and also makes fused Core simpler.
+    go g = x `seq` (x `cons` go g') where (x,g') = rand g
+
+
+instance Random Integer where
+  randomR ival g = randomIvalInteger ival g
+  random g       = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
+
+instance Random Int        where randomR = randomIvalIntegral; random = randomBounded
+instance Random Int8       where randomR = randomIvalIntegral; random = randomBounded
+instance Random Int16      where randomR = randomIvalIntegral; random = randomBounded
+instance Random Int32      where randomR = randomIvalIntegral; random = randomBounded
+instance Random Int64      where randomR = randomIvalIntegral; random = randomBounded
+
+#ifndef __NHC__
+-- Word is a type synonym in nhc98.
+instance Random Word       where randomR = randomIvalIntegral; random = randomBounded
+#endif
+instance Random Word8      where randomR = randomIvalIntegral; random = randomBounded
+instance Random Word16     where randomR = randomIvalIntegral; random = randomBounded
+instance Random Word32     where randomR = randomIvalIntegral; random = randomBounded
+instance Random Word64     where randomR = randomIvalIntegral; random = randomBounded
+
+instance Random CChar      where randomR = randomIvalIntegral; random = randomBounded
+instance Random CSChar     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CUChar     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CShort     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CUShort    where randomR = randomIvalIntegral; random = randomBounded
+instance Random CInt       where randomR = randomIvalIntegral; random = randomBounded
+instance Random CUInt      where randomR = randomIvalIntegral; random = randomBounded
+instance Random CLong      where randomR = randomIvalIntegral; random = randomBounded
+instance Random CULong     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CPtrdiff   where randomR = randomIvalIntegral; random = randomBounded
+instance Random CSize      where randomR = randomIvalIntegral; random = randomBounded
+instance Random CWchar     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CSigAtomic where randomR = randomIvalIntegral; random = randomBounded
+instance Random CLLong     where randomR = randomIvalIntegral; random = randomBounded
+instance Random CULLong    where randomR = randomIvalIntegral; random = randomBounded
+instance Random CIntPtr    where randomR = randomIvalIntegral; random = randomBounded
+instance Random CUIntPtr   where randomR = randomIvalIntegral; random = randomBounded
+instance Random CIntMax    where randomR = randomIvalIntegral; random = randomBounded
+instance Random CUIntMax   where randomR = randomIvalIntegral; random = randomBounded
+
+instance Random Char where
+  randomR (a,b) g =
+       case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
+         (x,g') -> (chr x, g')
+  random g        = randomR (minBound,maxBound) g
+
+instance Random Bool where
+  randomR (a,b) g =
+      case (randomIvalInteger (bool2Int a, bool2Int b) g) of
+        (x, g') -> (int2Bool x, g')
+       where
+         bool2Int :: Bool -> Integer
+         bool2Int False = 0
+         bool2Int True  = 1
+
+         int2Bool :: Int -> Bool
+         int2Bool 0     = False
+         int2Bool _     = True
+
+  random g        = randomR (minBound,maxBound) g
+
+{-# INLINE randomRFloating #-}
+randomRFloating :: (Fractional a, Num a, Ord a, Random a, RandomGen g) => (a, a) -> g -> (a, g)
+randomRFloating (l,h) g
+    | l>h       = randomRFloating (h,l) g
+    | otherwise = let (coef,g') = random g in
+                  (2.0 * (0.5*l + coef * (0.5*h - 0.5*l)), g')  -- avoid overflow
+
+instance Random Double where
+  randomR = randomRFloating
+  random rng     =
+    case random rng of
+      (x,rng') ->
+          -- We use 53 bits of randomness corresponding to the 53 bit significand:
+          ((fromIntegral (mask53 .&. (x::Int64)) :: Double)
+           /  fromIntegral twoto53, rng')
+   where
+    twoto53 = (2::Int64) ^ (53::Int64)
+    mask53 = twoto53 - 1
+
+instance Random Float where
+  randomR = randomRFloating
+  random rng =
+    -- TODO: Faster to just use 'next' IF it generates enough bits of randomness.
+    case random rng of
+      (x,rng') ->
+          -- We use 24 bits of randomness corresponding to the 24 bit significand:
+          ((fromIntegral (mask24 .&. (x::Int32)) :: Float)
+           /  fromIntegral twoto24, rng')
+         -- Note, encodeFloat is another option, but I'm not seeing slightly
+         --  worse performance with the following [2011.06.25]:
+--         (encodeFloat rand (-24), rng')
+   where
+     mask24 = twoto24 - 1
+     twoto24 = (2::Int32) ^ (24::Int32)
+
+-- CFloat/CDouble are basically the same as a Float/Double:
+instance Random CFloat where
+  randomR = randomRFloating
+  random rng = case random rng of
+                 (x,rng') -> (realToFrac (x::Float), rng')
+
+instance Random CDouble where
+  randomR = randomRFloating
+  -- A MYSTERY:
+  -- Presently, this is showing better performance than the Double instance:
+  -- (And yet, if the Double instance uses randomFrac then its performance is much worse!)
+  random  = randomFrac
+  -- random rng = case random rng of
+  --             (x,rng') -> (realToFrac (x::Double), rng')
+
+mkStdRNG :: Integer -> IO StdGen
+mkStdRNG o = do
+    ct          <- getCPUTime
+    (sec, psec) <- getTime
+    return (createStdGen (sec * 12345 + psec + ct + o))
+
+randomBounded :: (RandomGen g, Random a, Bounded a) => g -> (a, g)
+randomBounded = randomR (minBound, maxBound)
+
+-- The two integer functions below take an [inclusive,inclusive] range.
+randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)
+randomIvalIntegral (l,h) = randomIvalInteger (toInteger l, toInteger h)
+
+{-# SPECIALIZE randomIvalInteger :: (Num a) =>
+    (Integer, Integer) -> StdGen -> (a, StdGen) #-}
+
+randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
+randomIvalInteger (l,h) rng
+ | l > h     = randomIvalInteger (h,l) rng
+ | otherwise = case (f 1 0 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
+     where
+       (genlo, genhi) = genRange rng
+       b = fromIntegral genhi - fromIntegral genlo + 1
+
+       -- Probabilities of the most likely and least likely result
+       -- will differ at most by a factor of (1 +- 1/q).  Assuming the RandomGen
+       -- is uniform, of course
+
+       -- On average, log q / log b more random values will be generated
+       -- than the minimum
+       q = 1000
+       k = h - l + 1
+       magtgt = k * q
+
+       -- generate random values until we exceed the target magnitude
+       f mag v g | mag >= magtgt = (v, g)
+                 | otherwise = v' `seq`f (mag*b) v' g' where
+                        (x,g') = next g
+                        v' = (v * b + (fromIntegral x - fromIntegral genlo))
+
+
+-- The continuous functions on the other hand take an [inclusive,exclusive) range.
+randomFrac :: (RandomGen g, Fractional a) => g -> (a, g)
+randomFrac = randomIvalDouble (0::Double,1) realToFrac
+
+randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
+randomIvalDouble (l,h) fromDouble rng
+  | l > h     = randomIvalDouble (h,l) fromDouble rng
+  | otherwise =
+       case (randomIvalInteger (toInteger (minBound::Int32), toInteger (maxBound::Int32)) rng) of
+         (x, rng') ->
+            let
+             scaled_x =
+                fromDouble (0.5*l + 0.5*h) +                   -- previously (l+h)/2, overflowed
+                fromDouble ((0.5*h - 0.5*l) / (0.5 * realToFrac int32Count)) *  -- avoid overflow
+                fromIntegral (x::Int32)
+            in
+            (scaled_x, rng')
+
+int32Count :: Integer
+int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1  -- GHC ticket #3982
+
+stdRange :: (Int,Int)
+stdRange = (1, 2147483562)
+
+stdNext :: StdGen -> (Int, StdGen)
+-- Returns values in the range stdRange
+stdNext (StdGen s1 s2) = (fromIntegral z', StdGen s1'' s2'')
+        where   z'   = if z < 1 then z + 2147483562 else z
+                z    = s1'' - s2''
+
+                k    = s1 `quot` 53668
+                s1'  = 40014 * (s1 - k * 53668) - k * 12211
+                s1'' = if s1' < 0 then s1' + 2147483563 else s1'
+
+                k'   = s2 `quot` 52774
+                s2'  = 40692 * (s2 - k' * 52774) - k' * 3791
+                s2'' = if s2' < 0 then s2' + 2147483399 else s2'
+
+stdSplit            :: StdGen -> (StdGen, StdGen)
+stdSplit std@(StdGen s1 s2)
+                     = (left, right)
+                       where
+                        -- no statistical foundation for this!
+                        left    = StdGen new_s1 t2
+                        right   = StdGen t1 new_s2
+
+                        new_s1 | s1 == 2147483562 = 1
+                               | otherwise        = s1 + 1
+
+                        new_s2 | s2 == 1          = 2147483398
+                               | otherwise        = s2 - 1
+
+                        StdGen t1 t2 = snd (next std)
+
+-- The global random number generator
+
+{- $globalrng #globalrng#
+
+There is a single, implicit, global random number generator of type
+'StdGen', held in some global variable maintained by the 'IO' monad. It is
+initialised automatically in some system-dependent fashion, for example, by
+using the time of day, or Linux's kernel random number generator. To get
+deterministic behaviour, use 'setStdGen'.
+-}
+
+-- |Sets the global random number generator.
+setStdGen :: StdGen -> IO ()
+setStdGen sgen = writeIORef theStdGen sgen
+
+-- |Gets the global random number generator.
+getStdGen :: IO StdGen
+getStdGen  = readIORef theStdGen
+
+theStdGen :: IORef StdGen
+theStdGen  = unsafePerformIO $ do
+   rng <- mkStdRNG 0
+   newIORef rng
+
+-- |Applies 'split' to the current global random generator,
+-- updates it with one of the results, and returns the other.
+newStdGen :: IO StdGen
+newStdGen = atomicModifyIORef' theStdGen split
+
+{- |Uses the supplied function to get a value from the current global
+random generator, and updates the global generator with the new generator
+returned by the function. For example, @rollDice@ gets a random integer
+between 1 and 6:
+
+>  rollDice :: IO Int
+>  rollDice = getStdRandom (randomR (1,6))
+
+-}
+
+getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
+getStdRandom f = atomicModifyIORef' theStdGen (swap . f)
+  where swap (v,g) = (g,v)
+
+{- $references
+
+1. FW #Burton# Burton and RL Page, /Distributed random number generation/,
+Journal of Functional Programming, 2(2):203-212, April 1992.
+
+2. SK #Park# Park, and KW Miller, /Random number generators -
+good ones are hard to find/, Comm ACM 31(10), Oct 1988, pp1192-1201.
+
+3. DG #Carta# Carta, /Two fast implementations of the minimal standard
+random number generator/, Comm ACM, 33(1), Jan 1990, pp87-88.
+
+4. P #Hellekalek# Hellekalek, /Don\'t trust parallel Monte Carlo/,
+Department of Mathematics, University of Salzburg,
+<http://random.mat.sbg.ac.at/~peter/pads98.ps>, 1998.
+
+5. Pierre #LEcuyer# L'Ecuyer, /Efficient and portable combined random
+number generators/, Comm ACM, 31(6), Jun 1988, pp742-749.
+
+The Web site <http://random.mat.sbg.ac.at/> is a great source of information.
+
+-}
index 3d059bd..17d32ea 100644 (file)
@@ -104,6 +104,10 @@ test('allocLimit4', [ extra_run_opts('+RTS -xq300k -RTS'),
                       omit_ways(['ghci']) ],
                     compile_and_run, [''])
 
+test('performGC', [ only_ways(['threaded1','threaded2'])
+                  , extra_run_opts('400 +RTS -qg -RTS') ],
+                    compile_and_run, [''])
+
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run
 
diff --git a/testsuite/tests/concurrent/should_run/performGC.hs b/testsuite/tests/concurrent/should_run/performGC.hs
new file mode 100644 (file)
index 0000000..87a3271
--- /dev/null
@@ -0,0 +1,24 @@
+module Main (main) where
+
+-- Test for #10545
+
+import System.Environment
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import RandomPGC
+import System.Mem
+import qualified Data.Set as Set
+
+main = do
+  [n] <- getArgs
+  forkIO $ doSomeWork
+  forM [1..read n] $ \n -> do print n; threadDelay 1000; performMinorGC
+
+doSomeWork :: IO ()
+doSomeWork = forever $ do
+  ns <- replicateM 10000 randomIO :: IO [Int]
+  ms <- replicateM 1000 randomIO
+  let set = Set.fromList ns
+      elems = filter (`Set.member` set) ms
+  evaluate $ sum elems
diff --git a/testsuite/tests/concurrent/should_run/performGC.stdout b/testsuite/tests/concurrent/should_run/performGC.stdout
new file mode 100644 (file)
index 0000000..7b5d34d
--- /dev/null
@@ -0,0 +1,400 @@
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+12
+13
+14
+15
+16
+17
+18
+19
+20
+21
+22
+23
+24
+25
+26
+27
+28
+29
+30
+31
+32
+33
+34
+35
+36
+37
+38
+39
+40
+41
+42
+43
+44
+45
+46
+47
+48
+49
+50
+51
+52
+53
+54
+55
+56
+57
+58
+59
+60
+61
+62
+63
+64
+65
+66
+67
+68
+69
+70
+71
+72
+73
+74
+75
+76
+77
+78
+79
+80
+81
+82
+83
+84
+85
+86
+87
+88
+89
+90
+91
+92
+93
+94
+95
+96
+97
+98
+99
+100
+101
+102
+103
+104
+105
+106
+107
+108
+109
+110
+111
+112
+113
+114
+115
+116
+117
+118
+119
+120
+121
+122
+123
+124
+125
+126
+127
+128
+129
+130
+131
+132
+133
+134
+135
+136
+137
+138
+139
+140
+141
+142
+143
+144
+145
+146
+147
+148
+149
+150
+151
+152
+153
+154
+155
+156
+157
+158
+159
+160
+161
+162
+163
+164
+165
+166
+167
+168
+169
+170
+171
+172
+173
+174
+175
+176
+177
+178
+179
+180
+181
+182
+183
+184
+185
+186
+187
+188
+189
+190
+191
+192
+193
+194
+195
+196
+197
+198
+199
+200
+201
+202
+203
+204
+205
+206
+207
+208
+209
+210
+211
+212
+213
+214
+215
+216
+217
+218
+219
+220
+221
+222
+223
+224
+225
+226
+227
+228
+229
+230
+231
+232
+233
+234
+235
+236
+237
+238
+239
+240
+241
+242
+243
+244
+245
+246
+247
+248
+249
+250
+251
+252
+253
+254
+255
+256
+257
+258
+259
+260
+261
+262
+263
+264
+265
+266
+267
+268
+269
+270
+271
+272
+273
+274
+275
+276
+277
+278
+279
+280
+281
+282
+283
+284
+285
+286
+287
+288
+289
+290
+291
+292
+293
+294
+295
+296
+297
+298
+299
+300
+301
+302
+303
+304
+305
+306
+307
+308
+309
+310
+311
+312
+313
+314
+315
+316
+317
+318
+319
+320
+321
+322
+323
+324
+325
+326
+327
+328
+329
+330
+331
+332
+333
+334
+335
+336
+337
+338
+339
+340
+341
+342
+343
+344
+345
+346
+347
+348
+349
+350
+351
+352
+353
+354
+355
+356
+357
+358
+359
+360
+361
+362
+363
+364
+365
+366
+367
+368
+369
+370
+371
+372
+373
+374
+375
+376
+377
+378
+379
+380
+381
+382
+383
+384
+385
+386
+387
+388
+389
+390
+391
+392
+393
+394
+395
+396
+397
+398
+399
+400