Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,349
    • Issues 5,349
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 574
    • Merge requests 574
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #12614
Closed
Open
Issue created Sep 24, 2016 by jscholl@trac-jscholl

Integer division can overwrite other arguments to foreign call

If you call a foreign function, GHC can generate incorrect code while passing the arguments to the function, overwriting the 3rd argument if a later argument contains an integer division.

Main.hs:

{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

{-# NOINLINE foo #-}
foo :: Int -> IO ()
foo x = c_foo 0 0 x $ x + x `quot` 10

foreign import ccall "foo" c_foo :: Int -> Int -> Int -> Int -> IO ()

main :: IO ()
main = do
    foo 202
    foo 203
    foo 204

foo.c:

#include <stdio.h>

void foo(int a, int b, int c, int d) {
    printf("%d, %d, %d, %d\n", a, b, c, d);
}

Expected output:

0, 0, 202, 222
0, 0, 203, 223
0, 0, 204, 224

Actual output:

0, 0, 2, 222
0, 0, 3, 223
0, 0, 4, 224

The bug has to be somewhere in the code generator. The cmm reads:

call "ccall" arg hints:  [‘signed’, ‘signed’, ‘signed’, ‘signed’]  result hints:  [] foo(0, 0, _s3nE::I64, _s3nE::I64 + %MO_S_Quot_W64(_s3nE::I64, 10));

This generates the following assembler code:

        xorl %edi,%edi
        xorl %esi,%esi
        movq %rbx,%rdx
        movl $10,%ecx
        movq %rax,%rdx  <-- move 3rd argument into rdx
        movq %rbx,%rax
        movq %rdx,%r8
        cqto
        idivq %rcx      <-- rax := rax / rcx; rdx := rax % rcx
        movq %rbx,%rcx
        addq %rax,%rcx
        subq $8,%rsp
        xorl %eax,%eax
        movq %r8,%rbx
        call foo

Thus rdx is overwritten again before the call, leading to incorrect results.

Trac metadata
Trac field Value
Version 8.0.1
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler (NCG)
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking