[C2hs] Re: darcs patch: automagically support stdcall calling
convention when ...
Duncan Coutts
duncan.coutts at googlemail.com
Mon Jun 14 10:21:28 EDT 2010
On Mon, 2010-06-14 at 04:07 -0500, Jonathan Rockway wrote:
> 1 patch for repository http://code.haskell.org/c2hs:
>
> Mon Jun 14 03:58:17 CDT 2010 Jonathan Rockway <jon at jrock.us>
> * automagically support stdcall calling convention when the header file specifies it
That's great.
I've got a follow-on patch, perhaps you could review it?
I believe that one can specify attributes after a C function
declaration:
void foo() __attribute__((__stdcall__));
as well as before with the syntax
void __attribute__((__stdcall__)) foo();
This patch looks at the attributes in both positions.
Duncan
-------------- next part --------------
2 patches for repository http://code.haskell.org/c2hs/:
Mon Jun 14 09:58:17 BST 2010 Jonathan Rockway <jon at jrock.us>
* automagically support stdcall calling convention when the header file specifies it
Mon Jun 14 15:12:13 BST 2010 Duncan Coutts <duncan at haskell.org>
* Consider trailing stdcall attributes
For example: void foo() __attribute__((stdcall));
As well as: void __attribute__((stdcall)) foo();
Allow the stdcall as well as __stdcall__ attribute keyword,
all such gnu C attribute keywords exist in both forms.
New patches:
[automagically support stdcall calling convention when the header file specifies it
Jonathan Rockway <jon at jrock.us>**20100614085817
Ignore-this: d9ae8358959acb13d493c0530a96c8f8
] {
hunk ./src/C2HS/Gen/Bind.hs 130
SwitchBoard(..), Traces(..), putTraceStr, getSwitch)
import C2HS.C (AttrC, CObj(..), CTag(..),
CDecl(..), CDeclSpec(..), CTypeSpec(..),
- CStructUnion(..), CStructTag(..), CEnum(..), CDeclr(..),
+ CStructUnion(..), CStructTag(..), CEnum(..), CDeclr(..), CAttr(..),
CDerivedDeclr(..),CArrSize(..),
CExpr(..), CBinaryOp(..), CUnaryOp(..), CConst (..),
CInteger(..),cInteger,getCInteger,getCCharAsInt,
hunk ./src/C2HS/Gen/Bind.hs 143
checkForAlias, checkForOneAliasName, checkForOneCUName,
lookupEnum, lookupStructUnion, lookupDeclOrTag, isPtrDeclr,
dropPtrDeclr, isPtrDecl, getDeclOf, isFunDeclr,
- refersToNewDef, CDef(..))
+ refersToNewDef, partitionDeclSpecs, CDef(..))
-- friends
import C2HS.CHS (CHSModule(..), CHSFrag(..), CHSHook(..),
hunk ./src/C2HS/Gen/Bind.hs 788
extType <- extractFunType pos cdecl isPure
header <- getSwitch headerSB
when (isVariadic extType) (variadicErr pos (posOf cdecl))
- delayCode hook (foreignImport header ideLexeme hsLexeme isUns extType)
+ delayCode hook (foreignImport (extractCallingConvention cdecl)
+ header ideLexeme hsLexeme isUns extType)
traceFunType extType
where
traceFunType et = traceGenBind $
hunk ./src/C2HS/Gen/Bind.hs 811
-- | Haskell code for the foreign import declaration needed by a call hook
--
-foreignImport :: String -> String -> String -> Bool -> ExtType -> String
-foreignImport header ident hsIdent isUnsafe ty =
- "foreign import ccall " ++ safety ++ " " ++ show entity ++
+foreignImport :: CallingConvention -> String -> String -> String -> Bool -> ExtType -> String
+foreignImport cconv header ident hsIdent isUnsafe ty =
+ "foreign import " ++ showCallingConvention cconv ++ " " ++ safety
+ ++ " " ++ show entity ++
"\n " ++ hsIdent ++ " :: " ++ showExtType ty ++ "\n"
where
safety = if isUnsafe then "unsafe" else "safe"
hunk ./src/C2HS/Gen/Bind.hs 1724
int = CIntType undefined
signed = CSignedType undefined
+-- handle calling convention
+-- -------------------------
+
+data CallingConvention = StdCall | C_Call -- remove ambiguity with C2HS.C.CCall
+ deriving (Eq)
+
+-- | determine the calling convention for the provided decl
+extractCallingConvention :: CDecl -> CallingConvention
+extractCallingConvention (CDecl specs _ _) =
+ if hasStdCall then StdCall else C_Call
+ where hasStdCall' (CAttr x _ _) = identToString x == "__stdcall__"
+ hasStdCall = any hasStdCall' attributes
+ attributes = ((\(_,attrs,_,_,_) -> attrs) . partitionDeclSpecs) specs
+
+-- | generate the necessary parameter for "foreign import" for the
+-- provided calling convention
+showCallingConvention :: CallingConvention -> String
+showCallingConvention StdCall = "stdcall"
+showCallingConvention C_Call = "ccall"
+
-- offset and size computations
-- ----------------------------
}
[Consider trailing stdcall attributes
Duncan Coutts <duncan at haskell.org>**20100614141213
Ignore-this: 6bf9ba175b2b25d6eacca4be2607a704
For example: void foo() __attribute__((stdcall));
As well as: void __attribute__((stdcall)) foo();
Allow the stdcall as well as __stdcall__ attribute keyword,
all such gnu C attribute keywords exist in both forms.
] {
hunk ./src/C2HS/Gen/Bind.hs 1727
-- handle calling convention
-- -------------------------
-data CallingConvention = StdCall | C_Call -- remove ambiguity with C2HS.C.CCall
+data CallingConvention = StdCallConv
+ | CCallConv
deriving (Eq)
-- | determine the calling convention for the provided decl
hunk ./src/C2HS/Gen/Bind.hs 1733
extractCallingConvention :: CDecl -> CallingConvention
-extractCallingConvention (CDecl specs _ _) =
- if hasStdCall then StdCall else C_Call
- where hasStdCall' (CAttr x _ _) = identToString x == "__stdcall__"
- hasStdCall = any hasStdCall' attributes
- attributes = ((\(_,attrs,_,_,_) -> attrs) . partitionDeclSpecs) specs
+extractCallingConvention cdecl
+ | hasStdCallAttr cdecl = StdCallConv
+ | otherwise = CCallConv
+ where
+ isStdCallAttr (CAttr x _ _) = identToString x == "stdcall"
+ || identToString x == "__stdcall__"
+
+ hasStdCallAttr = any isStdCallAttr . funAttrs
+
+ funAttrs (CDecl specs declrs _) =
+ let (_,attrs',_,_,_) = partitionDeclSpecs specs
+ in attrs' ++ funEndAttrs declrs
+
+ -- attrs after the function name, e.g. void foo() __attribute__((...));
+ funEndAttrs [(Just ((CDeclr _ (CFunDeclr _ _ _ : _) _ attrs _)), _, _)] = attrs
+ funEndAttrs _ = []
+
-- | generate the necessary parameter for "foreign import" for the
-- provided calling convention
hunk ./src/C2HS/Gen/Bind.hs 1754
showCallingConvention :: CallingConvention -> String
-showCallingConvention StdCall = "stdcall"
-showCallingConvention C_Call = "ccall"
+showCallingConvention StdCallConv = "stdcall"
+showCallingConvention CCallConv = "ccall"
-- offset and size computations
}
Context:
[Deprecate unused functions in the C2HS source module
Duncan Coutts <duncan at haskell.org>**20100608003144
Ignore-this: 97a58b35219b3235cf4bccd11c49fc3e
It should not be a general provider of utility functions.
It should just be for marshaling functions that are needed
by code generated by c2hs.
]
[Generate standard marshalers for int, float and bool
Duncan Coutts <duncan at haskell.org>**20100608000741
Ignore-this: 302d7c98b3de571ed8f795c6272f9db8
Rather than non-stanard aliases from the annoying C2HS module.
]
[Remove redundant vim modeline which apparently confuses emacs
Duncan Coutts <duncan at haskell.org>**20100530224328
Ignore-this: 3d6c5aae17fb80fc690ebee4749d0acc
Also add ghc-options: -fwarn-tabs
]
[Extend the sizeof test to do alignment too
Duncan Coutts <duncan at haskell.org>**20100423174026
Ignore-this: 46730bba6e9c3b9a3de6f2049a0b08a6
The bitfield size tests fail. See ticket #10.
]
[Rename "alignment" keyword to "alignof"
Duncan Coutts <duncan at haskell.org>**20100423173753
Ignore-this: 4b3a8530eb5d65245c5b15b36069fe71
To match sizeof, and the GNU C __alignof__ keyword.
Also fix implementation to return the alignment rather than size.
]
[alignment keyword support
ron at gamr7.com**20091022153809
Ignore-this: 6bc67ccada198cb9979a0ed04a003839
]
[TAG 0.16.2
Duncan Coutts <duncan at haskell.org>**20100422171301
Ignore-this: 961a5a4883231850ff0f7248beb1b439
]
[Bump version number
Duncan Coutts <duncan at haskell.org>**20100422171232
Ignore-this: 8b89818bc1879f0403f9ba3f90bc07fa
Will use even numbers for releases.
]
[Specify GPL version number 2 in .cabal metadata
Duncan Coutts <duncan at haskell.org>**20100422171209
Ignore-this: 5088233f62c4286e17fe0d6267346c9d
]
[Fix a few warnings
Duncan Coutts <duncan at haskell.org>**20100422171022
Ignore-this: c3889d1a59cccc206c6a301db97633ce
]
[Remove a couple old comments that are no longer applicable
Duncan Coutts <duncan at haskell.org>**20100419224920
Ignore-this: 17026945fea02ec85ee1fa48fc2d86c5
]
[Bump version number
Duncan Coutts <duncan at haskell.org>**20100419224828
Ignore-this: 687f3af0846f640430e5e9bf33c39d96
]
[Specify source repository in .cabal file
Duncan Coutts <duncan at haskell.org>**20100419224706
Ignore-this: d9370e4b60aa8f27b761656c48c051ad
Requires Cabal 1.6, also allows using file globs for extra source files
]
[Workaround .chs lexer problem by using latin1 encoding
Duncan Coutts <duncan at haskell.org>**20100419224401
Ignore-this: 6714eb66dcda0e766b4e933f082ce839
The .chs lexer cannot handle chars > 255 so as a workaround force the
file I/O to use latin1 encoding. This becomes a problem with base-4.2
since by default it uses locale encoding where preciously it used only
latin1 encoding. Eventually we should move to .chs files being utf8
since .hs files are utf8.
]
[Improve error message formatting in some cases
Duncan Coutts <duncan at haskell.org>**20100419224223
Ignore-this: 311b937efd9ce34897ed58f8ca84b44e
Workaround for wierd Show instance for CError from language-c
]
[Fix printing of FFI foreign entity strings to not have leading whitespace
Duncan Coutts <duncan at haskell.org>**20100419223932
Ignore-this: 3ca3ce15b0efb62e5560dc13de293253
Early betas of ghc-6.12 could not parse these. Fixed in 6.12.1 I think
but still worth making the output prettier.
]
[Fix line number info in error messages about C function types
Duncan Coutts <duncan at haskell.org>**20100419223032
Ignore-this: a3e40d7ae3ae51613505289d0ab4ad8f
Preserve source positions when constructing attributes while
analysing C function declarations. In particular this fixed the
error messages for binding long double C types.
]
[Workaround the lack of CLDouble support in ghc/base
Duncan Coutts <duncan at haskell.org>**20100419134939
Ignore-this: 29920798e12fdc8dbcef328a0d94af9e
If users try to bind to functions that use "long double" they
will get an error message about the type not being supported.
]
[TAG 0.16.0
Duncan Coutts <duncan at haskell.org>**20090228132823]
Patch bundle hash:
3b9368c725f5aa64c811b35eb2517c980cae7211
More information about the C2hs
mailing list