Skip to content
Snippets Groups Projects
  1. Jun 28, 2020
    • Ryan Scott's avatar
      Use NHsCoreTy to embed types into GND-generated code · 42f797b0
      Ryan Scott authored and Marge Bot's avatar Marge Bot committed
      `GeneralizedNewtypeDeriving` is in the unique situation where it must
      produce an `LHsType GhcPs` from a Core `Type`. Historically, this was
      done with the `typeToLHsType` function, which walked over the entire
      `Type` and attempted to construct an `LHsType` with the same overall
      structure. `typeToLHsType` is quite complicated, however, and has
      been the subject of numerous bugs over the years (e.g., #14579).
      
      Luckily, there is an easier way to accomplish the same thing: the
      `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`,
      which allows embedding a Core `Type` directly into an `HsType`,
      avoiding the need to laboriously convert from one to another (as
      `typeToLHsType` did). Moreover, renaming and typechecking an
      `XHsType` is simple, since one doesn't need to do anything to a
      Core `Type`...
      
      ...well, almost. For the reasons described in
      `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must
      apply a substitution that we build from the local `tcl_env` type
      environment. But that's a relatively modest price to pay.
      
      Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the
      `typeToLHsType` function no longer has any uses in GHC, so this patch
      rips it out. Some additional tweaks to `hsTypeNeedsParens` were
      necessary to make the new `-ddump-deriv` output correctly
      parenthesized, but other than that, this patch is quite
      straightforward.
      
      This is a mostly internal refactoring, although it is likely that
      `GeneralizedNewtypeDeriving`-generated code will now need fewer
      language extensions in certain situations than it did before.
      42f797b0
    • Peter Trommler's avatar
      RTS: Refactor Haskell-C glue for PPC 64-bit · d8ba9e6f
      Peter Trommler authored and Marge Bot's avatar Marge Bot committed
      Make sure the stack is 16 byte aligned even when reserved stack
      bytes are not a multiple of 16 bytes.
      
      Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn
      has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the
      function prologue.
      
      Use the ABI provided functions to save clobbered GPRs and FPRs.
      
      Improve comments. Describe what the stack looks like and how it relates
      to the respective ABIs.
      d8ba9e6f
  2. Jun 27, 2020
    • Krzysztof Gogolewski's avatar
      Don't generalize when typechecking a tuple section · 0e83efa2
      Krzysztof Gogolewski authored and Marge Bot's avatar Marge Bot committed
      The code is simpler and cleaner.
      0e83efa2
    • Sylvain Henry's avatar
      DynFlags: don't store buildTag · a04020b8
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      `DynFlags.buildTag` was a field created from the set of Ways in
      `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which
      was fragile. We want to avoid global state like this (#17957).
      
      Moreover in #14335 we also want to support loading units with different
      ways: target units would still use `DynFlags.ways` but plugins would use
      `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build
      tag and with ways, we recompute the buildTag on-the-fly (should be
      pretty cheap) and we remove `DynFlags.buildTag` field.
      a04020b8
    • Simon Peyton Jones's avatar
      Better loop detection in findTypeShape · a74ec37c
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      Andreas pointed out, in !3466, that my fix for #18304 was not
      quite right.  This patch fixes it properly, by having just one
      RecTcChecker rather than (implicitly) two nested ones, in
      findTypeShape.
      a74ec37c
    • Sylvain Henry's avatar
      Fix ghc-bignum exceptions · 1b3d13b6
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      We must ensure that exceptions are not simplified. Previously we used:
      
         case raiseDivZero of
            _ -> 0## -- dummyValue
      
      But it was wrong because the evaluation of `raiseDivZero` was removed and
      the dummy value was directly returned. See new Note [ghc-bignum exceptions].
      
      I've also removed the exception triggering primops which were fragile.
      We don't need them to be primops, we can have them exported by ghc-prim.
      
      I've also added a test for #18359 which triggered this patch.
      1b3d13b6
    • Sylvain Henry's avatar
      ghc-bignum: fix division by zero (#18359) · a403eb91
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      a403eb91
    • Ryan Scott's avatar
      Revamp the treatment of auxiliary bindings for derived instances · ce987865
      Ryan Scott authored and Marge Bot's avatar Marge Bot committed
      This started as a simple fix for #18321 that organically grew into a
      much more sweeping refactor of how auxiliary bindings for derived
      instances are handled. I have rewritten `Note [Auxiliary binders]`
      in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but
      the highlights are:
      
      * Previously, the OccName of each auxiliary binding would be given
        a suffix containing a hash of its package name, module name, and
        parent data type to avoid name clashes. This was needlessly
        complicated, so we take the more direct approach of generating
        `Exact` `RdrName`s for each auxiliary binding with the same
        `OccName`, but using an underlying `System` `Name` with a fresh
        `Unique` for each binding. Unlike hashes, allocating new `Unique`s
        does not require any cleverness and avoid name clashes all the
        same...
      * ...speaking of which, in order to convince the renamer that multiple
        auxiliary bindings with the same `OccName` (but different
        `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of
        `rnTopBindsLHS` to rename auxiliary bindings. Again, see
        `Note [Auxiliary binders]` for the full story.
      * I have removed the `DerivHsBind` constructor for
        `DerivStuff`—which was only used for `Data.Data`-related
        auxiliary bindings—and refactored `gen_Data_binds` to use
        `DerivAuxBind` instead. This brings the treatment of
        `Data.Data`-related auxiliary bindings in line with every other
        form of auxiliary binding.
      
      Fixes #18321.
      ce987865
  3. Jun 26, 2020
    • Matthías Páll Gissurarson's avatar
      Implement the proposed -XQualifiedDo extension · 9ee58f8d
      Matthías Páll Gissurarson authored
      
      Co-authored-by: default avatarFacundo Domínguez <facundo.dominguez@tweag.io>
      
      QualifiedDo is implemented using the same placeholders for operation names in
      the AST that were devised for RebindableSyntax. Whenever the renamer checks
      which names to use for do syntax, it first checks if the do block is qualified
      (e.g. M.do { stmts }), in which case it searches for qualified names in
      the module M.
      
      This allows users to write
      
          {-# LANGUAGE QualifiedDo #-}
          import qualified SomeModule as M
      
          f x = M.do           -- desugars to:
            y <- M.return x    -- M.return x M.>>= \y ->
            M.return y         -- M.return y M.>>
            M.return y         -- M.return y
      
      See Note [QualifiedDo] and the users' guide for more details.
      
      Issue #18214
      
      Proposal:
      https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst
      
      Since we change the constructors `ITdo` and `ITmdo` to carry the new module
      name, we need to bump the haddock submodule to account or the new shape of
      these constructors.
      9ee58f8d
    • Sebastian Graf's avatar
      GHC.Core.Unify: Make UM actions one-shot by default · a3d69dc6
      Sebastian Graf authored and Ben Gamari's avatar Ben Gamari committed
      This MR makes the UM monad in GHC.Core.Unify into a one-shot
      monad.  See the long Note [The one-shot state monad trick].
      
      See also #18202 and !3309, which applies this to all Reader/State-like
      monads in GHC for compile-time perf improvements. The pattern used
      here enables something similar to the state-hack, but is applicable to
      user-defined monads, not just `IO`.
      
      Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'):
          haddock.Cabal
      a3d69dc6
  4. Jun 25, 2020
    • Sylvain Henry's avatar
      RTS: avoid overflow on 32-bit arch (#18375) · d3c2d59b
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      We're now correctly computing allocated bytes on 32-bit arch, so we get
      huge increases.
      
      Metric Increase:
          haddock.Cabal
          haddock.base
          haddock.compiler
          space_leak_001
      d3c2d59b
    • Ben Gamari's avatar
      rts/Hash: Simplify freeing of HashListChunks · a788d4d1
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      While looking at #18348 I noticed that the treatment of HashLists are a
      bit more complex than necessary (which lead to some initial confusion on
      my part). Specifically, we allocate HashLists in chunks. Each chunk
      allocation makes two allocations: one for the chunk itself and one for a
      HashListChunk to link together the chunks for the purposes of freeing.
      
      Simplify this (and hopefully make the relationship between these
      clearer) but allocating the HashLists and HashListChunk in a single
      malloc. This will both make the implementation easier to follow and
      reduce C heap fragmentation.
      
      Note that even after this patch we fail to bound the size of the free
      HashList pool. However, this is a separate bug.
      a788d4d1
    • Roland Senn's avatar
      Enable maxBound checks for OverloadedLists (Fixes #18172) · fe281b27
      Roland Senn authored and Marge Bot's avatar Marge Bot committed
      Consider the Literal `[256] :: [Data.Word.Word8]`
      
      When the `OverloadedLists` extension is not active, then the `ol_ext` field
      in the `OverLitTc` record that is passed to the function `getIntegralLit`
      contains the type `Word8`. This is a simple type, and we can use its
      type constructor immediately for the `warnAboutOverflowedLiterals` function.
      
      When the `OverloadedLists` extension is active, then the `ol_ext` field
      contains the type family `Item [Word8]`. The function `nomaliseType` is used
      to convert it to the needed type `Word8`.
      fe281b27
    • Artem Pelenitsyn's avatar
      test suite: add reproducer for #17516 · c50ef26e
      Artem Pelenitsyn authored and Marge Bot's avatar Marge Bot committed
      c50ef26e
    • Oleg Grenrus's avatar
      Add MonadZip and MonadFix instances for Complex · 67a86b4d
      Oleg Grenrus authored and Marge Bot's avatar Marge Bot committed
      These instances are taken from
      https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html
      
      They are the unique possible, so let they be in `base`.
      67a86b4d
    • Takenobu Tani's avatar
      Clean up haddock hyperlinks of GHC.* (part2) · 1eb997a8
      Takenobu Tani authored and Marge Bot's avatar Marge Bot committed
      This updates haddock comments only.
      
      This patch focuses to update for hyperlinks in GHC API's haddock comments,
      because broken links especially discourage newcomers.
      
      This includes the following hierarchies:
      
        - GHC.Iface.*
        - GHC.Llvm.*
      
        - GHC.Rename.*
        - GHC.Tc.*
      
        - GHC.HsToCore.*
        - GHC.StgToCmm.*
        - GHC.CmmToAsm.*
      
        - GHC.Runtime.*
      
        - GHC.Unit.*
        - GHC.Utils.*
        - GHC.SysTools.*
      1eb997a8
    • Takenobu Tani's avatar
      Clean up haddock hyperlinks of GHC.* (part1) · c7dd6da7
      Takenobu Tani authored and Marge Bot's avatar Marge Bot committed
      This updates haddock comments only.
      
      This patch focuses to update for hyperlinks in GHC API's haddock comments,
      because broken links especially discourage newcomers.
      
      This includes the following hierarchies:
        - GHC.Hs.*
        - GHC.Core.*
        - GHC.Stg.*
        - GHC.Cmm.*
        - GHC.Types.*
        - GHC.Data.*
        - GHC.Builtin.*
        - GHC.Parser.*
        - GHC.Driver.*
        - GHC top
      c7dd6da7
    • Zubin's avatar
      Export everything from HsToCore. · 90f43872
      Zubin authored and Marge Bot's avatar Marge Bot committed
      This lets us reuse these functions in haddock, avoiding synchronization bugs.
      
      Also fixed some divergences with haddock in that file
      
      Updates haddock submodule
      90f43872
    • Oleg Grenrus's avatar
      Export readBinIface_ · 284001d0
      Oleg Grenrus authored and Marge Bot's avatar Marge Bot committed
      284001d0
    • Adam Wespiser's avatar
      add examples to Data.Traversable · 8ddbed4a
      Adam Wespiser authored and Marge Bot's avatar Marge Bot committed
      8ddbed4a
    • Simon Peyton Jones's avatar
      Expunge GhcTcId · 0d61f866
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      GHC.Hs.Extension had
      
        type GhcPs   = GhcPass 'Parsed
        type GhcRn   = GhcPass 'Renamed
        type GhcTc   = GhcPass 'Typechecked
        type GhcTcId = GhcTc
      
      The last of these, GhcTcId, is a vestige of the past.
      
      This patch expunges it from GHC.
      0d61f866
    • Ben Gamari's avatar
      hadrian/make: Detect makeindex · 4acc2934
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      Previously we would simply assume that makeindex was available.
      Now we correctly detect it in `configure` and respect this conclusion in
      hadrian and make.
      4acc2934
    • Ben Gamari's avatar
      make: Respect XELATEX variable · 30e42652
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      Previously we simply ignored the XELATEX variable when building
      PDF documentation.
      30e42652
    • Roland Senn's avatar
      In `:break ident` allow out of scope and nested identifiers (Fix #3000) · 7e6d3d09
      Roland Senn authored and Marge Bot's avatar Marge Bot committed
      This patch fixes the bug and implements the feature request of #3000.
      
      1. If `Module` is a real module name and `identifier` a name of a
      top-level function in `Module` then `:break Module.identifer` works
      also for an `identifier` that is out of scope.
      
      2. Extend the syntax for `:break identifier` to:
      
          :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent]
      
      `ModQual` is optional and is either the effective name of a module or
      the local alias of a qualified import statement.
      
      `topLevelIdent` is the name of a top level function in the module
      referenced by `ModQual`.
      
      `nestedIdent` is optional and the name of a function nested in a let or
      where clause inside the previously mentioned function `nestedIdent` or
      `topLevelIdent`.
      
      If `ModQual` is a module name, then `topLevelIdent` can be any top level
      identifier in this module. If `ModQual` is missing or a local alias of a
      qualified import, then `topLevelIdent` must be in scope.
      
      Breakpoints can be set on arbitrarily deeply nested functions, but the
      whole chain of nested function names must be specified.
      
      3. To support the new functionality rewrite the code to tab complete `:break`.
      7e6d3d09
    • Andreas Klebinger's avatar
      Enable large address space optimization on windows. · 03a708ba
      Andreas Klebinger authored and Marge Bot's avatar Marge Bot committed
      Starting with Win 8.1/Server 2012 windows no longer preallocates
      page tables for reserverd memory eagerly, which prevented us from
      using this approach in the past.
      
      We also try to allocate the heap high in the memory space.
      Hopefully this makes it easier to allocate things in the low
      4GB of memory that need to be there. Like jump islands for the
      linker.
      03a708ba
  5. Jun 24, 2020
    • Krzysztof Gogolewski's avatar
      Add missing entry to freeNamesItem (#18369) · a1f34d37
      Krzysztof Gogolewski authored and Marge Bot's avatar Marge Bot committed
      a1f34d37
    • Sylvain Henry's avatar
      Fix invalid printf format · 7ad4085c
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      7ad4085c
    • Sylvain Henry's avatar
      Don't use timesInt2# with GHC < 8.11 (fix #18358) · b5768cce
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      b5768cce
    • Simon Peyton Jones's avatar
      Two small tweaks to Coercion.simplifyArgsWorker · 625a7f54
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      These tweaks affect the inner loop of simplifyArgsWorker, which
      in turn is called from the flattener in Flatten.hs.  This is
      a key perf bottleneck to T9872{a,b,c,d}.
      
      These two small changes have a modest but useful benefit.
      No change in functionality whatsoever.
      
      Relates to #18354
      625a7f54
    • Simon Peyton Jones's avatar
      Fix a buglet in Simplify.simplCast · 181516bc
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      This bug, revealed by #18347, is just a missing update to
      sc_hole_ty in simplCast.  I'd missed a code path when I
      made the recentchanges in
      
          commit 6d49d5be
          Author: Simon Peyton Jones <simonpj@microsoft.com>
          Date:   Thu May 21 12:53:35 2020 +0100
      
          Implement cast worker/wrapper properly
      
      The fix is very easy.
      
      Two other minor changes
      
      * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an
        outright bug, introduced in the fix to #18112: we were simplifying
        the same coercion twice *with the same substitution*, which is just
        wrong.  It'd be a hard bug to trigger, so I just fixed it; less code
        too.
      
      * Better debug printing of ApplyToVal
      181516bc
    • xldenis's avatar
      Fix issue #18262 by zonking constraints after solving · a2a9006b
      xldenis authored and Marge Bot's avatar Marge Bot committed
      Zonk residual constraints in checkForExistence to reveal user type
      errors.
      
      Previously when `:instances` was used with instances that have TypeError
      constraints the result would look something like:
      
      instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10
      
      whereas after zonking, `:instances` now sees the `TypeError` and
      properly eliminates the constraint from the results.
      a2a9006b
    • Sylvain Henry's avatar
      Add tests for #17920 · cad62ef1
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      Metric Decrease:
          T12150
          T12234
      cad62ef1
    • Sylvain Henry's avatar
      LLVM: refactor and comment register padding code (#17920) · 5f6a0665
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      5f6a0665
    • Sylvain Henry's avatar
      CmmToC: don't add extern decl to parsed Cmm data · 2636794d
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      Previously, if a .cmm file *not in the RTS* contained something like:
      
      ```cmm
      section "rodata" { msg : bits8[] "Test\n"; }
      ```
      
      It would get compiled by CmmToC into:
      
      ```c
      ERW_(msg);
      const char msg[] = "Test\012";
      ```
      
      and fail with:
      
      ```
      /tmp/ghc32129_0/ghc_4.hc:5:12: error:
           error: conflicting types for \u2018msg\u2019
           const char msg[] = "Test\012";
                      ^~~
      
      In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error:
      
      /tmp/ghc32129_0/ghc_4.hc:4:6: error:
           note: previous declaration of \u2018msg\u2019 was here
           ERW_(msg);
                ^
      
      /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error:
           note: in definition of macro \u2018ERW_\u2019
           #define ERW_(X)   extern       StgWordArray (X)
                                                        ^
      ```
      
      See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
      
      Now we don't generate these extern declarations (ERW_, etc.) for
      top-level data. It shouldn't change anything for the RTS (the only place
      we use .cmm files) as it is already special cased in
      `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit
      extern declarations when needed.
      
      Note that it allows `cgrun069` test to pass with CmmToC (cf #15467).
      2636794d
    • Sylvain Henry's avatar
      Cmm: introduce SAVE_REGS/RESTORE_REGS · 7750bd45
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      We don't want to save both Fn and Dn register sets on x86-64 as they are
      aliased to the same arch register (XMMn).
      
      Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]`
      which makes a set of Cmm registers alive so that they cover all arch
      registers used to pass parameter, we could have Fn, Dn and XMMn alive at
      the same time. It made the LLVM code generator choke (see #17920).
      
      Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of
      registers.
      7750bd45
    • John Ericson's avatar
      Switch from HscSource to IsBootInterface for module lookup in GhcMake · 809caedf
      John Ericson authored and Marge Bot's avatar Marge Bot committed
      We look up modules by their name, and not their contents. There is no
      way to separately reference a signature vs regular module; you get what
      you get. Only boot files can be referenced indepenently with `import {-#
      SOURCE #-}`.
      809caedf
  6. Jun 19, 2020
    • Sylvain Henry's avatar
      Move tablesNextToCode field into Platform · d4a0be75
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      tablesNextToCode is a platform setting and doesn't belong into DynFlags
      (#17957). Doing this is also a prerequisite to fix #14335 where we deal
      with two platforms (target and host) that may have different platform
      settings.
      d4a0be75
    • Sylvain Henry's avatar
      DynFlags: store default depth in SDocContext (#17957) · 2af0ec90
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      It avoids having to use DynFlags to reach for pprUserLength.
      2af0ec90
    • Tamar Christina's avatar
      fix windows bootstrap due to linker changes · da18ff99
      Tamar Christina authored and Marge Bot's avatar Marge Bot committed
      da18ff99
    • Ömer Sinan Ağacan's avatar
      Fix uninitialized field read in Linker.c · 08c1cb0f
      Ömer Sinan Ağacan authored and Marge Bot's avatar Marge Bot committed
      Valgrind report of the bug when running the test `linker_unload`:
      
          ==29666== Conditional jump or move depends on uninitialised value(s)
          ==29666==    at 0x369C5B4: setOcInitialStatus (Linker.c:1305)
          ==29666==    by 0x369C6C5: mkOc (Linker.c:1347)
          ==29666==    by 0x36C027A: loadArchive_ (LoadArchive.c:522)
          ==29666==    by 0x36C0600: loadArchive (LoadArchive.c:626)
          ==29666==    by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload)
          ==29666==
          ==29666== Conditional jump or move depends on uninitialised value(s)
          ==29666==    at 0x369C5B4: setOcInitialStatus (Linker.c:1305)
          ==29666==    by 0x369C6C5: mkOc (Linker.c:1347)
          ==29666==    by 0x369C9F6: preloadObjectFile (Linker.c:1507)
          ==29666==    by 0x369CA8D: loadObj_ (Linker.c:1536)
          ==29666==    by 0x369CB17: loadObj (Linker.c:1557)
          ==29666==    by 0x3866BC: main (linker_unload.c:33)
      
      The problem is `mkOc` allocates a new `ObjectCode` and calls
      `setOcInitialStatus` without initializing the `status` field.
      `setOcInitialStatus` reads the field as first thing:
      
          static void setOcInitialStatus(ObjectCode* oc) {
              if (oc->status == OBJECT_DONT_RESOLVE)
                return;
      
              if (oc->archiveMemberName == NULL) {
                  oc->status = OBJECT_NEEDED;
              } else {
                  oc->status = OBJECT_LOADED;
              }
          }
      
      `setOcInitialStatus` is unsed in two places for two different purposes:
      in `mkOc` where we don't have the `status` field initialized yet (`mkOc`
      is supposed to initialize it), and `loadOc` where we do have `status`
      field initialized and we want to update it. Instead of splitting the
      function into two functions which are both called just once I inline the
      functions in the use sites and remove it.
      
      Fixes #18342
      08c1cb0f
Loading