%
\begin{code}
-module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
+module StixPrim ( primCode, amodeToStix, amodeToStix', foreignCallCode )
+ where
#include "HsVersions.h"
import AbsCUtils ( getAmodeRep, mixedTypeLocn )
import SMRep ( fixedHdrSize )
import Literal ( Literal(..), word2IntLit )
-import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) )
+import PrimOp ( PrimOp(..) )
import PrimRep ( PrimRep(..), getPrimRepSizeInBytes )
import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
import CLabel ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
mkMAP_FROZEN_infoLabel, mkEMPTY_MVAR_infoLabel,
mkForeignLabel )
-import CallConv ( cCallConv )
+import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..),
+ CCallConv(..), playSafe )
import Outputable
import FastTypes
#include "NCG.h"
\end{code}
-The main honcho here is primCode, which handles the guts of COpStmts.
+The main honchos here are primCode anf foreignCallCode, which handle the guts of COpStmts.
\begin{code}
+foreignCallCode
+ :: [CAddrMode] -- results
+ -> ForeignCall -- op
+ -> [CAddrMode] -- args
+ -> UniqSM StixTreeList
+
primCode
:: [CAddrMode] -- results
-> PrimOp -- op
-> UniqSM StixTreeList
\end{code}
+%************************************************************************
+%* *
+\subsubsection{Code for foreign calls}
+%* *
+%************************************************************************
+
First, the dreaded @ccall@. We can't handle @casm@s.
Usually, this compiles to an assignment, but when the left-hand side
btw Why not let programmer use casm to provide assembly code instead
of C code? ADR
+ToDo: saving/restoring of volatile regs around ccalls.
+
+JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
+rather than inheriting the calling convention of the thing which we're really
+calling.
+
+\begin{code}
+foreignCallCode lhs (CCall (CCallSpec (StaticTarget fn) cconv safety)) rhs
+ | not (playSafe safety) = returnUs (\xs -> ccall : xs)
+
+ | otherwise
+ = save_thread_state `thenUs` \ save ->
+ load_thread_state `thenUs` \ load ->
+ getUniqueUs `thenUs` \ uniq ->
+ let
+ id = StReg (StixTemp uniq IntRep)
+
+ suspend = StAssign IntRep id
+ (StCall SLIT("suspendThread") {-no:cconv-} CCallConv
+ IntRep [stgBaseReg])
+ resume = StCall SLIT("resumeThread") {-no:cconv-} CCallConv
+ VoidRep [id]
+ in
+ returnUs (\xs -> save (suspend : ccall : resume : load xs))
+
+ where
+ args = map amodeCodeForCCall rhs
+ amodeCodeForCCall x =
+ let base = amodeToStix' x
+ in
+ case getAmodeRep x of
+ ArrayRep -> StIndex PtrRep base arrPtrsHS
+ ByteArrayRep -> StIndex IntRep base arrWordsHS
+ ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
+ _ -> base
+
+ ccall = case lhs of
+ [] -> StCall fn cconv VoidRep args
+ [lhs] -> StAssign pk lhs' (StCall fn cconv pk args)
+ where
+ lhs' = amodeToStix lhs
+ pk = case getAmodeRep lhs of
+ FloatRep -> FloatRep
+ DoubleRep -> DoubleRep
+ other -> IntRep
+
+foreignCallCode lhs call rhs
+ = ncgPrimopMoan "Native code generator can't handle foreign call" (ppr call)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection{Code for primops}
+%* *
+%************************************************************************
+
The (MP) integer operations are a true nightmare. Since we don't have
a convenient abstract way of allocating temporary variables on the (C)
stack, we use the space just below HpLim for the @MP_INT@ structures,
primCode [res] Integer2WordOp arg@[sa,da]
= gmpInteger2Word res (sa,da)
-primCode [res] Int2AddrOp [arg]
- = simpleCoercion AddrRep res arg
-
-primCode [res] Addr2IntOp [arg]
- = simpleCoercion IntRep res arg
-
primCode [res] Int2WordOp [arg]
= simpleCoercion IntRep{-WordRep?-} res arg
primCode [res] AddrToHValueOp [arg]
= simpleCoercion PtrRep res arg
-primCode [res] IntToInt8Op [arg]
+#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
+primCode [res] Int2AddrOp [arg]
+ = simpleCoercion AddrRep res arg
+
+primCode [res] Addr2IntOp [arg]
+ = simpleCoercion IntRep res arg
+#endif
+
+primCode [res] Narrow8IntOp [arg]
= narrowingCoercion IntRep Int8Rep res arg
-primCode [res] IntToInt16Op [arg]
+primCode [res] Narrow16IntOp [arg]
= narrowingCoercion IntRep Int16Rep res arg
-primCode [res] IntToInt32Op [arg]
+primCode [res] Narrow32IntOp [arg]
= narrowingCoercion IntRep Int32Rep res arg
-primCode [res] WordToWord8Op [arg]
+primCode [res] Narrow8WordOp [arg]
= narrowingCoercion WordRep Word8Rep res arg
-primCode [res] WordToWord16Op [arg]
+primCode [res] Narrow16WordOp [arg]
= narrowingCoercion WordRep Word16Rep res arg
-primCode [res] WordToWord32Op [arg]
+primCode [res] Narrow32WordOp [arg]
= narrowingCoercion WordRep Word32Rep res arg
\end{code}
\end{code}
-ToDo: saving/restoring of volatile regs around ccalls.
-
-JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
-rather than inheriting the calling convention of the thing which we're really
-calling.
-
-\begin{code}
-primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
- | is_asm = error "ERROR: Native code generator can't handle casm"
- | not may_gc = returnUs (\xs -> ccall : xs)
- | otherwise =
- save_thread_state `thenUs` \ save ->
- load_thread_state `thenUs` \ load ->
- getUniqueUs `thenUs` \ uniq ->
- let
- id = StReg (StixTemp uniq IntRep)
-
- suspend = StAssign IntRep id
- (StCall SLIT("suspendThread") {-no:cconv-} cCallConv
- IntRep [stgBaseReg])
- resume = StCall SLIT("resumeThread") {-no:cconv-} cCallConv
- VoidRep [id]
- in
- returnUs (\xs -> save (suspend : ccall : resume : load xs))
-
- where
- args = map amodeCodeForCCall rhs
- amodeCodeForCCall x =
- let base = amodeToStix' x
- in
- case getAmodeRep x of
- ArrayRep -> StIndex PtrRep base arrPtrsHS
- ByteArrayRep -> StIndex IntRep base arrWordsHS
- ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
- _ -> base
-
- ccall = case lhs of
- [] -> StCall fn cconv VoidRep args
- [lhs] ->
- let lhs' = amodeToStix lhs
- pk = case getAmodeRep lhs of
- FloatRep -> FloatRep
- DoubleRep -> DoubleRep
- other -> IntRep
- in
- StAssign pk lhs' (StCall fn cconv pk args)
-\end{code}
DataToTagOp won't work for 64-bit archs, as it is.
\begin{code}
simplePrim pk [lhs] op rest = StAssign pk lhs (StPrim op rest)
-simplePrim pk as op bs = simplePrim_error op
-
-simplePrim_error op
- = error ("ERROR: primitive operation `"++show op++"'cannot be handled\nby the native-code generator. Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
+simplePrim pk as op bs = ncgPrimopMoan "simplPrim(all targets)" (ppr op)
\end{code}
%---------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff