#5967: incompatible implicit declaration of function 'memcpy'
------------------------------+---------------------------------------------
 Reporter:  nomeata           |          Owner:                  
     Type:  bug               |         Status:  new             
 Priority:  normal            |      Component:  Compiler        
  Version:  7.4.1             |       Keywords:                  
       Os:  Unknown/Multiple  |   Architecture:  Unknown/Multiple
  Failure:  Other             |       Testcase:                  
Blockedby:                    |       Blocking:                  
  Related:                    |  
------------------------------+---------------------------------------------

Comment(by nomeata):

 Ok, here is almost a minimal example:

 {{{
 {-# LANGUAGE MagicHash, ForeignFunctionInterface #-}

 module Test where

 import GHC.Prim
 import Foreign.Ptr
 import Foreign.C

 foreign import ccall unsafe "memcpy"
    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())

 test = copyByteArray#
 }}}

 Compiling this yields
 {{{
 '/usr/bin/gcc' '-fno-stack-protector' '-Wl,--hash-size=31' '-Wl,--reduce-
 memory-overheads' '-x' 'c' '/tmp/ghc13588_0/ghc13588_0.hc' \
  '-o' '/tmp/ghc13588_0/ghc13588_0.s' '-fwrapv' '-fno-strict-aliasing' '-S'
 '-Wimplicit' '-O' '-D__GLASGOW_HASKELL__=704'\
  '-DNO_REGS' '-DUSE_MINIINTERPRETER' '-I' '.' '-I'
 '/usr/lib/ghc/base-4.5.0.0/include' '-I' '/usr/lib/ghc/include'\

 /tmp/ghc13588_0/ghc13588_0.hc: In function ‘Test_test_entry’:

 /tmp/ghc13588_0/ghc13588_0.hc:29:1:
      warning: implicit declaration of function ‘memcpy’ [-Wimplicit-
 function-declaration]

 /tmp/ghc13588_0/ghc13588_0.hc:29:1:
      warning: incompatible implicit declaration of built-in function
 ‘memcpy’ [enabled by default]
 /tmp/ghc13588_0/ghc13588_0.hc: In function ‘Test_zdwccall_entry’:

 /tmp/ghc13588_0/ghc13588_0.hc:56:2:
      warning: conflicting types for built-in function ‘memcpy’ [enabled by
 default]
 }}}

 But if I then modify the .hc file and move the {{{memcpy((void *)_c19o,
 (void *)_c19n, _c19m);}}} call to the bottom of the file, after the
 {{{EF_(memcpy)}}}, then I get:
 {{{
 /tmp/ghc13380_0/ghc13380_0.hc: In function ‘Test_zdwccall_entry’:
 /tmp/ghc13380_0/ghc13380_0.hc:43:2: warning: conflicting types for built-
 in function ‘memcpy’ [enabled by default]
 /tmp/ghc13380_0/ghc13380_0.hc: In function ‘Test_test_entry’:
 /tmp/ghc13380_0/ghc13380_0.hc:181:1: warning: implicit declaration of
 function ‘memcpy’ [-Wimplicit-function-declaration]
 /tmp/ghc13380_0/ghc13380_0.hc:74:2: note: previous declaration of ‘memcpy’
 was here
 /tmp/ghc13380_0/ghc13380_0.hc:181:1: error: incompatible implicit
 declaration of function ‘memcpy’
 /tmp/ghc13380_0/ghc13380_0.hc:74:2: note: previous implicit declaration of
 ‘memcpy’ was here
 }}}
 so the order of declarations gets important.

 So a solution seems to be to generate the {{{EF_(...)}}} style call also
 for memcpy (is there a runtime performance penalty)? The code to look at
 seems to be source:compiler/cmm/PprC.hs, especially {{{pprStmt}}}, where a
 memcpy can occur as a {{{CmmPrim MO_Memcpy}}} or as a {{{CmmCall}}} (which
 does the EF_ stuff).

 Commentary/Compiler/Backends/PprC#Prototypes seems to be related.

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5967#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler

_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to