<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  </head>
  <body>
    <p>That sounds like a great change, and beautifully dovetails with
      !3658. (In fact an earlier version of that PR also attempted the
      Int32 change.)</p>
    <p>I would just try to finish that and/or reuse the techniques.
      Sylvain has been doing all the work lately as I've been starved
      for time/ideas, so talk to him.</p>
    <p>John</p>
    <div class="moz-cite-prefix">On 10/22/20 9:45 AM, Moritz Angermann
      wrote:<br>
    </div>
    <blockquote type="cite"
cite="mid:CAKfdd-w81Fk5UCOkDN425SqVEXuVY=iWGiqoLUs-yKGT76W8Dw@mail.gmail.com">
      <meta http-equiv="content-type" content="text/html; charset=UTF-8">
      <div dir="ltr">Hi *,
        <div><br>
        </div>
        <div>so, after some discussion with Simon and Simon, as well as
          Ben, we are all in agreement that using sized hints</div>
        <div>is a band-aid solution for the real underlying problem. 
          Where the underlying problem is that we have CInt ~ Int32,</div>
        <div>and we represent Int32 as I32# Int#.  And the proper
          solution would not likely be to represent Int32 as I32#
          Int32#.</div>
        <div><br>
        </div>
        <div>After some trial and error (mostly be being too aggressive
          on changing Ints to sized ones, unnecessarily -- thanks</div>
        <div>Ben for helping me stay on course!), I've produce what
          mostly amounts to this patch[1].</div>
        <div><br>
        </div>
        <div>It also requires some additional narrow/extend calls to a
          few Data.Array.Base signatures to make them typecheck.</div>
        <div><br>
        </div>
        <div>However I've got plenty of failures in the testsuite now.
          Hooray!</div>
        <div><br>
        </div>
        <div>Most of them are of this form:<br>
          <br>
        </div>
        <div><font face="monospace">*** Core Lint errors : in result of
            Desugar (before optimization) ***<br>
            T12010.hsc:34:1: warning:<br>
                Argument value doesn't match argument type:<br>
                Fun type: Int# -> Int#<br>
                Arg type: Int32#<br>
                Arg: ds_d1B3<br>
                In the RHS of c_socket :: CInt -> CInt -> CInt
            -> IO CInt<br>
                In the body of lambda with binder ds_d1AU :: Int32<br>
                In the body of lambda with binder ds_d1AV :: Int32<br>
                In the body of lambda with binder ds_d1AW :: Int32<br>
                In a case alternative: (I32# ds_d1AY :: Int32#)<br>
                In a case alternative: (I32# ds_d1B0 :: Int32#)<br>
                In a case alternative: (I32# ds_d1B2 :: Int32#)<br>
                In the body of lambda with binder ds_d1B5 :: State#
            RealWorld<br>
                In a case alternative: ((#,#) ds_d1B4 :: State#
            RealWorld,<br>
                                              ds_d1B3 :: Int32#)<br>
                Substitution: [TCvSubst<br>
                                 In scope: InScope {}<br>
                                 Type env: []<br>
                                 Co env: []]</font><br>
        </div>
        <div><br>
        </div>
        <div>(full log at <a
            href="https://gist.github.com/angerman/3d6e1e3da5299b9365125ee9e0a2c40f"
            moz-do-not-send="true">https://gist.github.com/angerman/3d6e1e3da5299b9365125ee9e0a2c40f</a>)</div>
        <div><br>
        </div>
        <div>Some other minor ones are test that now need explicit
          narrow/extending where it didn't need before.</div>
        <div><br>
        </div>
        <div>As well as this beauty:</div>
        <div><br>
        </div>
        <div><font face="monospace">-- RHS size: {terms: 16, types: 0,
            coercions: 0, joins: 0/0}<br>
            i32 :: Int32<br>
            [GblId,<br>
             Cpr=m1,<br>
             Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True,
            ConLike=True,<br>
                     WorkFree=False, Expandable=False, Guidance=IF_ARGS
            [] 23 10}]<br>
            i32<br>
              = GHC.Int.I32#<br>
                  (GHC.Prim.narrowInt32#<br>
                     (GHC.Prim.andI#<br>
                        (GHC.Prim.extendInt32#<br>
                           (GHC.Prim.narrowInt32#<br>
                              (GHC.Prim.extendInt32#
            (GHC.Prim.narrowInt32# 1#))))<br>
                        (GHC.Prim.extendInt32#<br>
                           (GHC.Prim.narrowInt32#<br>
                              (GHC.Prim.notI#<br>
                                 (GHC.Prim.extendInt32#<br>
                                    (GHC.Prim.narrowInt32#<br>
                                       (GHC.Prim.extendInt32#
            (GHC.Prim.narrowInt32# 1#)))))))))</font><br>
        </div>
        <div><br>
        </div>
        <div>This clearly needs some clean up.</div>
        <div><br>
        </div>
        <div>Apart from that the rest seems to be mostly working. Any
          input would be appreciated. I'll need to do the same for</div>
        <div>Word as well I'm afraid.</div>
        <div><br>
        </div>
        <div>Cheers,</div>
        <div> Moritz</div>
        <div>--</div>
        <div>[1]: <a
href="https://gitlab.haskell.org/ghc/ghc/-/commit/acb5ce792806bc3c1e1730c6bdae853d2755de16?merge_request_iid=3641"
            moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/-/commit/acb5ce792806bc3c1e1730c6bdae853d2755de16?merge_request_iid=3641</a></div>
      </div>
      <br>
      <div class="gmail_quote">
        <div dir="ltr" class="gmail_attr">On Tue, Oct 20, 2020 at 10:34
          PM Cheng Shao <<a href="mailto:cheng.shao@tweag.io"
            target="_blank" moz-do-not-send="true">cheng.shao@tweag.io</a>>
          wrote:<br>
        </div>
        <blockquote class="gmail_quote" style="margin:0px 0px 0px
          0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Indeed
          STG to Cmm lowering drops the correct size information for<br>
          ccall arguments, there's even a TODO comment that has been
          around for<br>
          quite a few years:<br>
          <a
href="https://gitlab.haskell.org/ghc/ghc/-/blob/master/compiler/GHC/StgToCmm/Foreign.hs#L83"
            rel="noreferrer" target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/-/blob/master/compiler/GHC/StgToCmm/Foreign.hs#L83</a><br>
          <br>
          This has been an annoyance for Asterius as well. When we try
          to<br>
          translate a CmmUnsafeForeignCall node to a wasm function call,
          a CInt<br>
          argument (which should be i32 in wasm) can be mistyped as i64
          which<br>
          causes a validation error. We have to insert wrap/extend
          opcodes based<br>
          on the callee function signature, but if we preserve correct
          argument<br>
          size in Cmm (or at least enrich the hints to include it), we
          won't<br>
          need such a hack.<br>
          <br>
          On Tue, Oct 20, 2020 at 4:05 PM Moritz Angermann<br>
          <<a href="mailto:moritz.angermann@gmail.com"
            target="_blank" moz-do-not-send="true">moritz.angermann@gmail.com</a>>
          wrote:<br>
          ><br>
          > Yes, that's right. I'm not sure it's in core though, as
          the width information still seems to be available in Stg.
          However the lowering from<br>
          > stg into cmm widens it.<br>
          ><br>
          > On Tue, Oct 20, 2020 at 9:57 PM Carter Schonwald <<a
            href="mailto:carter.schonwald@gmail.com" target="_blank"
            moz-do-not-send="true">carter.schonwald@gmail.com</a>>
          wrote:<br>
          >><br>
          >> ... are you talking about Haskell Int and word? Those
          are always the same size in bits and should match native point
          size. That is definitely an assumption of ghc<br>
          >><br>
          >> It sounds like some information that is dropped after
          core is needed to correctly do something in stg/cmm in the
          context of the ARM64 ncg that was recently added to handle
          cint being 32bit in this context ?<br>
          >><br>
          >><br>
          >> On Tue, Oct 20, 2020 at 5:49 AM Moritz Angermann <<a
            href="mailto:moritz.angermann@gmail.com" target="_blank"
            moz-do-not-send="true">moritz.angermann@gmail.com</a>>
          wrote:<br>
          >>><br>
          >>> Alright, let me expand a bit.  I've been looking
          at aarch64 NCG for ghc.  The Linux side of things is looking
          really good,<br>
          >>> so I've moved onto the macOS side (I'm afraid I
          don't have any Windows aarch64 hardware, nor much windows
          knowledge<br>
          >>> to even attempt a Windows version yet).<br>
          >>><br>
          >>> When calling C functions, the usual approach is
          to pass the first few arguments in registers, and then
          arguments that exceed<br>
          >>> the argument passing slots on the stack.  The Arm
          AArch64 Procedure Call Standard (aapcs) for C does this by
          assigning 8byte<br>
          >>> slots to each overflow argument on the stack.  A
          company I won't name, has decided to implement a slightly
          different variation of<br>
          >>> the Procedure Call Standard, often referred to as
          darwinpcs.  This deviates from the aapcs for vargs, as well as
          for handling of<br>
          >>> spilled arguments on the stack.<br>
          >>><br>
          >>> The aapcs allows us to generate calls to C
          functions without knowing the actual prototype of the
          function, as all arguments are<br>
          >>> simply spilled into 8byte slots on the stack. 
          The darwinpcs however requires us to know the size of the
          arguments, so we can<br>
          >>> properly pack them onto the stack.  Ints have 4
          bytes, so we need to pack them into 4byte slots.<br>
          >>><br>
          >>> In the process library we have this rather fun
          foreign import:<br>
          >>> foreign import ccall unsafe
          "runInteractiveProcess"<br>
          >>>   c_runInteractiveProcess<br>
          >>>         ::  Ptr CString<br>
          >>>         -> CString<br>
          >>>         -> Ptr CString<br>
          >>>         -> FD<br>
          >>>         -> FD<br>
          >>>         -> FD<br>
          >>>         -> Ptr FD<br>
          >>>         -> Ptr FD<br>
          >>>         -> Ptr FD<br>
          >>>         -> Ptr CGid<br>
          >>>         -> Ptr CUid<br>
          >>>         -> CInt                         --
          reset child's SIGINT & SIGQUIT handlers<br>
          >>>         -> CInt                         --
          flags<br>
          >>>         -> Ptr CString<br>
          >>>         -> IO PHANDLE<br>
          >>><br>
          >>> with the corresponding C declaration:<br>
          >>><br>
          >>> extern ProcHandle runInteractiveProcess( char
          *const args[],<br>
          >>>                                          char
          *workingDirectory,<br>
          >>>                                          char
          **environment,<br>
          >>>                                          int
          fdStdIn,<br>
          >>>                                          int
          fdStdOut,<br>
          >>>                                          int
          fdStdErr,<br>
          >>>                                          int
          *pfdStdInput,<br>
          >>>                                          int
          *pfdStdOutput,<br>
          >>>                                          int
          *pfdStdError,<br>
          >>>                                          gid_t
          *childGroup,<br>
          >>>                                          uid_t
          *childUser,<br>
          >>>                                          int
          reset_int_quit_handlers,<br>
          >>>                                          int
          flags,<br>
          >>>                                          char
          **failed_doing);<br>
          >>> This function thus takes 14 arguments. We pass
          only the first 8 arguments in registers, and the others on the
          stack.<br>
          >>> Argument 12 and 13 are of type int.  On linux
          using the aapcs, we can pass those in 8byte slots on the
          stack. That is<br>
          >>> both of them are effectively 64bits wide when
          passed.  However for darwinpcs, it is expected that these
          adhere to their<br>
          >>> size and are packed as such. Therefore Argument
          12 and 13 need to be passed as 4byte slots each on the stack.<br>
          >>><br>
          >>> This yields a moderate 8byte saving on the stack
          for the same function call on darwinpcs compared to aapcs.<br>
          >>><br>
          >>> Now onto GHC.  When we generate function calls
          for foreign C functions, we deal with something like:<br>
          >>><br>
          >>> genCCall<br>
          >>>     :: ForeignTarget      -- function to call<br>
          >>>     -> [CmmFormal]        -- where to put the
          result<br>
          >>>     -> [CmmActual]        -- arguments (of
          mixed type)<br>
          >>>     -> BlockId            -- The block we are
          in<br>
          >>>     -> NatM (InstrBlock, Maybe BlockId)<br>
          >>><br>
          >>> based on Cmm Nodes of the form
          CmmUnsafeForeignCall target result_regs args<br>
          >>><br>
          >>> The CmmActual in the care of
          runInteractiveProcess hold the arguments for the function,
          however contrary to the function<br>
          >>> declaration, it contains I64 slots for Argument
          12 and 13. Thus computing the space needed for them based on
          their Cmm<br>
          >>> Representations yields 8bytes, when they should
          really be 32bit and consume only 4 byte.<br>
          >>><br>
          >>> To illustrate this a bit better: here is what we
          see in the pretty printed cmm:<br>
          >>><br>
          >>> (_s6w3::I64) = call "ccall" arg hints:  [PtrHint,
          PtrHint, PtrHint, signed, signed, signed, PtrHint, PtrHint,
          PtrHint, PtrHint, PtrHint, signed, signed, PtrHint]  result
          hints:  [signed] _runInteractiveProcess(I64[Sp + 96], I64[Sp +
          88], I64[Sp + 104], I64[Sp + 112], I64[Sp + 120], I64[Sp +
          56], I64[Sp + 64], I64[Sp + 72], I64[Sp + 24], 0, 0, I64[Sp +
          8], I64[Sp + 40] | I64[Sp + 48] | I64[Sp + 80] | 3, I64[R1 +
          7]);<br>
          >>><br>
          >>> I've added size information to the ForeignHints
          (NoHint, AddrHint, SignedHint) we have, and computed both,
          which yields:<br>
          >>><br>
          >>> [(CmmReg (CmmLocal (LocalReg s6Gi (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gk (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gm (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Go (CmmType
          BitsCat W64))),SignedHint W32)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gq (CmmType
          BitsCat W64))),SignedHint W32)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gs (CmmType
          BitsCat W64))),SignedHint W32)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gu (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gw (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Gy (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6Cp (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6FU (CmmType
          BitsCat W64))),AddrHint)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6GA (CmmType
          BitsCat W64))),SignedHint W32)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6GR (CmmType
          BitsCat W64))),SignedHint W32)<br>
          >>> ,(CmmReg (CmmLocal (LocalReg s6GM (CmmType
          BitsCat W64))),AddrHint)]<br>
          >>><br>
          >>> Thus, while we *do* know the right size from STG
          (which is what the Hints are computed from), we loose this
          information when lowering<br>
          >>> into Cmm, where we represent them with W64. This
          is what I was alluding to in the previous email. In
          primRepCmmType, and mkIntCLit, we set their type to 64bit for
          Ints; which on this platform does not hold.<br>
          >>><br>
          >>> Now I've gone ahead and effectively assume Cmm is
          lying to me when generating Foreign Function Calls, and rely
          on the (new) sized<br>
          >>> hints to produce the appropriate argument packing
          on the stack.  However I believe the correct way would be for
          GHC not to conflate Ints<br>
          >>> and Words in Cmm; implicitly assuming they are
          the same width.  Sadly it's not as simple as having
          primRepCmmType and mkIntCLit produce 32bit types. I fear GHC
          internally assumes "Int" means 64bit Integer, and then just
          happens to make the Int ~ CInt assumption.<br>
          >>><br>
          >>> Cheers,<br>
          >>>  Moritz<br>
          >>><br>
          >>> On Tue, Oct 20, 2020 at 3:33 PM Simon Peyton
          Jones <<a href="mailto:simonpj@microsoft.com"
            target="_blank" moz-do-not-send="true">simonpj@microsoft.com</a>>
          wrote:<br>
          >>>><br>
          >>>> Moritz<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> I’m afraid I don’t understand any of this. 
          Not your fault, but  I just don’t have enough context to know
          what you mean.<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Is there a current bug?  If so, can you
          demonstrate it?   If not, what is the problem you want to
          solve?  Examples are always helpful.<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Maybe it’s worth opening a ticket too?<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Thanks!<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Simon<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> From: ghc-devs <<a
            href="mailto:ghc-devs-bounces@haskell.org" target="_blank"
            moz-do-not-send="true">ghc-devs-bounces@haskell.org</a>>
          On Behalf Of Moritz Angermann<br>
          >>>> Sent: 20 October 2020 02:51<br>
          >>>> To: ghc-devs <<a
            href="mailto:ghc-devs@haskell.org" target="_blank"
            moz-do-not-send="true">ghc-devs@haskell.org</a>><br>
          >>>> Subject: GHC's internal confusion about Ints
          and Words<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Hi there!<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> So there is a procedure calling convention
          that for reasons I did not fully understand, but seem to be
          historically grown, uses packed arguments for those that are
          spilled onto the stack. On top of that, CInt is 32bit, Word is
          64bits. This provides the following spectacle:<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> While we know in STG that the CInt is 32bits
          wide, when lowered into Cmm, it's represented as I64 in the
          arguments to the C function.  Thus packing based on the format
          of the Cmm type would yield 8 bytes. And now, all further
          packed arguments have the wrong offset (by four).<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Specifically in GHC.Cmm.Utils we find:<br>
          >>>><br>
          >>>> primRepCmmType :: Platform -> PrimRep
          -> CmmType<br>
          >>>><br>
          >>>> primRepCmmType platform IntRep = bWord
          platform<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> mkIntCLit :: Platform -> Int -> CmmLit<br>
          >>>> mkIntCLit platform i = CmmInt (toInteger i)
          (wordWidth platform)<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> The naive idea to just fix this and make them
          return cIntWidth instead, seemingly produces the correct Cmm
          expressions at a local level, but produces a broken compiler.<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> A second approach could be to extend the
          Hints into providing sizes, and using those during the foreign
          call generation to pack spilled arguments.  This however
          appears to be more of a patching up of some fundamental
          underlying issue, instead of rectifying it properly.<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Maybe I'll have to go down the Hint path, it
          does however break current Eq assumptions, as they are sized
          now, and what was equal before, is only equal now if they
          represent the same size.<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> From a cursory glance at the issues with
          naively fixing the width for Int, it seems that GHC internally
          assumes sizeof(Int) = sizeof(Word).  Maybe there is a whole
          level of HsInt vs CInt discrimination missing?<br>
          >>>><br>
          >>>><br>
          >>>><br>
          >>>> Cheers,<br>
          >>>><br>
          >>>>  Moritz<br>
          >>><br>
          >>> _______________________________________________<br>
          >>> ghc-devs mailing list<br>
          >>> <a href="mailto:ghc-devs@haskell.org"
            target="_blank" moz-do-not-send="true">ghc-devs@haskell.org</a><br>
          >>> <a
            href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs"
            rel="noreferrer" target="_blank" moz-do-not-send="true">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
          ><br>
          > _______________________________________________<br>
          > ghc-devs mailing list<br>
          > <a href="mailto:ghc-devs@haskell.org" target="_blank"
            moz-do-not-send="true">ghc-devs@haskell.org</a><br>
          > <a
            href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs"
            rel="noreferrer" target="_blank" moz-do-not-send="true">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
        </blockquote>
      </div>
      <br>
      <fieldset class="mimeAttachmentHeader"></fieldset>
      <pre class="moz-quote-pre" wrap="">_______________________________________________
ghc-devs mailing list
<a class="moz-txt-link-abbreviated" href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a>
<a class="moz-txt-link-freetext" href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a>
</pre>
    </blockquote>
  </body>
</html>