import OrdList ( OrdList )
import PrimOp ( commutableOp, PrimOp(..) )
import RegAllocInfo ( mkMRegsState, MRegsState )
-import Stix ( StixTree(..), StixReg(..), pprStixTrees )
-import PrimRep ( isFloatingRep )
+import Stix ( StixTree(..), StixReg(..),
+ pprStixTrees, CodeSegment(..) )
+import PrimRep ( isFloatingRep, PrimRep(..) )
import UniqSupply ( returnUs, thenUs, mapUs, initUs,
initUs_, UniqSM, UniqSupply )
import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
import PrimOp ( PrimOp(..) )
import CallConv ( cCallConv )
import Stix ( getUniqLabelNCG, StixTree(..),
- StixReg(..), CodeSegment(..), pprStixTrees
+ StixReg(..), CodeSegment(..),
+ pprStixTrees, ppStixReg
)
import UniqSupply ( returnUs, thenUs, mapUs, mapAndUnzipUs,
mapAccumLUs, UniqSM
)
import Outputable
+import PprMach ( pprSize )
\end{code}
Code extractor for an entire stix tree---stix statement level.
StComment s -> returnInstr (COMMENT s)
StSegment seg -> returnInstr (SEGMENT seg)
-#if 1
- -- StFunBegin, normal non-debugging code for all architectures
StFunBegin lab -> returnInstr (IF_ARCH_alpha(FUNBEGIN lab,LABEL lab))
-#else
- -- StFunBegin, special tracing code for x86-Linux only
- -- requires you to supply
- -- void native_trace ( char* str )
- StFunBegin lab -> getUniqLabelNCG `thenUs` \ str_lbl ->
- returnUs (mkSeqInstrs [
- LABEL lab,
- COMMENT SLIT("begin trace sequence"),
- SEGMENT DataSegment,
- LABEL str_lbl,
- ASCII True (showSDoc (pprCLabel_asm lab)),
- SEGMENT TextSegment,
- PUSHA,
- PUSH L (OpImm (ImmCLbl str_lbl)),
- CALL (ImmLit (text "native_trace")),
- ADD L (OpImm (ImmInt 4)) (OpReg esp),
- POPA,
- COMMENT SLIT("end trace sequence")
- ])
-#endif
-
StFunEnd lab -> IF_ARCH_alpha(returnInstr (FUNEND lab),returnUs id)
StLabel lab -> returnInstr (LABEL lab)
where
off = StInt (i * sizeOf pk)
-#ifndef i386_TARGET_ARCH
mangleIndexTree (StIndex pk base off)
- = StPrim IntAddOp [base,
- case pk of
- CharRep -> off
- _ -> let
- s = shift pk
- in
- ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
- StPrim SllOp [off, StInt s]
- ]
+ = StPrim IntAddOp [
+ base,
+ let s = shift pk
+ in ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
+ if s == 0 then off else StPrim SllOp [off, StInt s]
+ ]
where
shift DoubleRep = 3::Integer
+ shift CharRep = 0::Integer
shift _ = IF_ARCH_alpha(3,2)
-#else
--- Hmm..this is an attempt at fixing Adress amodes (i.e., *[disp](base,index,<n>),
--- that do include the size of the primitive kind we're addressing. When StIndex
--- is expanded to actual code, the index (in units) is by the above code approp.
--- shifted to get the no. of bytes. Since Address amodes do contain size info
--- explicitly, we disable the shifting for x86s.
-mangleIndexTree (StIndex pk base off) = StPrim IntAddOp [base, off]
-#endif
-
\end{code}
\begin{code}
in
returnUs (Any DoubleRep code)
+getRegister (StScratchWord i)
+ = let code dst = mkSeqInstr (LEA L (OpAddr (spRel (-1000+i))) (OpReg dst))
+ in returnUs (Any PtrRep code)
getRegister (StPrim primop [x]) -- unary PrimOps
= case primop of
DoubleCoshOp -> (False, SLIT("cosh"))
DoubleTanhOp -> (False, SLIT("tanh"))
+ other
+ -> pprPanic "getRegister(x86,unary primop)"
+ (pprStixTrees [StPrim primop [x]])
+
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
= case primop of
CharGtOp -> condIntReg GTT x y
DoubleLtOp -> condFltReg LTT x y
DoubleLeOp -> condFltReg LE x y
- IntAddOp -> {- ToDo: fix this, whatever it is (WDP 96/04)...
- -- this should be optimised by the generic Opts,
- -- I don't know why it is not (sometimes)!
- case args of
- [x, StInt 0] -> getRegister x
- _ -> add_code L x y
- -}
- add_code L x y
-
+ IntAddOp -> add_code L x y
IntSubOp -> sub_code L x y
IntQuotOp -> quot_code L x y True{-division-}
IntRemOp -> quot_code L x y False{-remainder-}
where promote x = StPrim Float2DoubleOp [x]
DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep
[x, y])
+ other
+ -> pprPanic "getRegister(x86,dyadic primop)"
+ (pprStixTrees [StPrim primop [x, y]])
where
--------------------
src2 = ImmInt (fromInteger y)
code__2 dst
= code .
- mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
+ mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
(OpReg dst))
in
returnUs (Any IntRep code__2)
returnUs (Any PtrRep code)
| otherwise
= pprPanic "getRegister(x86)" (pprStixTrees [leaf])
-
where
imm = maybeImm leaf
imm__2 = case imm of Just x -> x
in
returnUs (Amode (AddrBaseIndex (Just reg) Nothing off) code)
-getAmode (StPrim IntAddOp [x, y])
+getAmode (StPrim IntAddOp [x, StPrim SllOp [y, StInt shift]])
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
= getNewRegNCG PtrRep `thenUs` \ tmp1 ->
getNewRegNCG IntRep `thenUs` \ tmp2 ->
getRegister x `thenUs` \ register1 ->
code2 = registerCode register2 tmp2 asmVoid
reg2 = registerName register2 tmp2
code__2 = asmParThen [code1, code2]
+ base = case shift of 0 -> 1 ; 1 -> 2; 2 -> 4; 3 -> 8
in
- returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
+ returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,base)) (ImmInt 0))
+ code__2)
getAmode leaf
| maybeToBool imm
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
-assignIntCode pk (StInd _ dst) src
+assignIntCode pk dd@(StInd _ dst) src
= getAmode dst `thenUs` \ amode ->
- get_op_RI src `thenUs` \ (codesrc, opsrc, sz) ->
+ get_op_RI src `thenUs` \ (codesrc, opsrc) ->
let
code1 = amodeCode amode asmVoid
dst__2 = amodeAddr amode
code__2 = asmParThen [code1, codesrc asmVoid] .
- mkSeqInstr (MOV sz opsrc (OpAddr dst__2))
+ mkSeqInstr (MOV (primRepToSize pk) opsrc (OpAddr dst__2))
in
returnUs code__2
where
get_op_RI
:: StixTree
- -> UniqSM (InstrBlock,Operand, Size) -- code, operator, size
+ -> UniqSM (InstrBlock,Operand) -- code, operator
get_op_RI op
| maybeToBool imm
- = returnUs (asmParThen [], OpImm imm_op, L)
+ = returnUs (asmParThen [], OpImm imm_op)
where
imm = maybeImm op
imm_op = case imm of Just x -> x
let
code = registerCode register tmp
reg = registerName register tmp
- pk = registerRep register
- sz = primRepToSize pk
in
- returnUs (code, OpReg reg, sz)
+ returnUs (code, OpReg reg)
-assignIntCode pk dst (StInd _ src)
+assignIntCode pk dst (StInd pks src)
= getNewRegNCG IntRep `thenUs` \ tmp ->
getAmode src `thenUs` \ amode ->
getRegister dst `thenUs` \ register ->
src__2 = amodeAddr amode
code2 = registerCode register tmp asmVoid
dst__2 = registerName register tmp
- sz = primRepToSize pk
+ szs = primRepToSize pks
code__2 = asmParThen [code1, code2] .
- mkSeqInstr (MOV sz (OpAddr src__2) (OpReg dst__2))
+ case szs of
+ L -> mkSeqInstr (MOV L (OpAddr src__2) (OpReg dst__2))
+ B -> mkSeqInstr (MOVZxL B (OpAddr src__2) (OpReg dst__2))
in
returnUs code__2
chrCode x
= getRegister x `thenUs` \ register ->
- --getNewRegNCG IntRep `thenUs` \ reg ->
let
code__2 dst = let
code = registerCode register dst
primRepToSize DataPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize RetRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize CostCentreRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CharRep = IF_ARCH_alpha( BU, IF_ARCH_i386( L, IF_ARCH_sparc( BU,)))
+primRepToSize CharRep = IF_ARCH_alpha( BU, IF_ARCH_i386( B, IF_ARCH_sparc( BU,)))
primRepToSize IntRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize WordRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize AddrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-- Moves.
| MOV Size Operand Operand
- | MOVZX Size Operand Operand -- size is the size of operand 2
- | MOVSX Size Operand Operand -- size is the size of operand 2
+ | MOVZxL Size Operand Operand -- size is the size of operand 1
+ | MOVSxL Size Operand Operand -- size is the size of operand 1
-- Load effective address (also a very useful three-operand add instruction :-)
\begin{code}
#include "nativeGen/NCG.h"
-module PprMach ( pprInstr ) where
+module PprMach ( pprInstr, pprSize ) where
#include "HsVersions.h"
,)))
pprInstr (SEGMENT TextSegment)
- = ptext
- IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
- ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
- ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
- ,)))
+ = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
+ ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
+ ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
+ ,)))
pprInstr (SEGMENT DataSegment)
= ptext
#endif
pprInstr (MOV size src dst)
= pprSizeOpOp SLIT("mov") size src dst
-pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
-pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
+pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
+pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
gsp = char ' '
gregno (FixedReg i) = I# i
gregno (MappedReg i) = I# i
+gregno other = pprPanic "gregno" (text (show other))
pprG :: Instr -> SDoc -> SDoc
pprG fake actual
pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
pprSizeOpOpCoerce name size1 size2 op1 op2
- = hcat [ char '\t', ptext name, space,
+ = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
pprOperand size1 op1,
comma,
pprOperand size2 op2
regUsage instr = case instr of
MOV sz src dst -> usage2 src dst
- MOVZX sz src dst -> usage2 src dst
- MOVSX sz src dst -> usage2 src dst
+ MOVZxL sz src dst -> usage2 src dst
+ MOVSxL sz src dst -> usage2 src dst
LEA sz src dst -> usage2 src dst
ADD sz src dst -> usage2 src dst
SUB sz src dst -> usage2 src dst
LABEL _ -> noUsage
ASCII _ _ -> noUsage
DATA _ _ -> noUsage
- _ -> error ("regUsage: " ++ showSDoc (pprInstr instr)) --noUsage
+ _ -> error ("regUsage(x86): " ++ showSDoc (pprInstr instr))
where
usage2 :: Operand -> Operand -> RegUsage
usage2 op (OpReg reg) = usage (opToReg op) [reg]
patchRegs instr env = case instr of
MOV sz src dst -> patch2 (MOV sz) src dst
- MOVZX sz src dst -> patch2 (MOVZX sz) src dst
- MOVSX sz src dst -> patch2 (MOVSX sz) src dst
+ MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst
+ MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst
LEA sz src dst -> patch2 (LEA sz) src dst
ADD sz src dst -> patch2 (ADD sz) src dst
SUB sz src dst -> patch2 (SUB sz) src dst
\begin{code}
module Stix (
CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
- sStLitLbl, pprStixTrees,
+ sStLitLbl, pprStixTrees, ppStixReg,
stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
| StCall FAST_STRING CallConv PrimRep [StixTree]
+ -- A volatile memory scratch array, which is allocated
+ -- relative to the stack pointer. It is an array of
+ -- ptr/word/int sized things. Do not expect to be preserved
+ -- beyond basic blocks or over a ccall. Current max size
+ -- is 6, used in StixInteger.
+
+ | StScratchWord Int
+
-- Assembly-language comments
| StComment FAST_STRING
StCall nm cc k args
-> paren (text "Call" <+> ptext nm <+>
pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
- where
- pprPrimRep = text . showPrimRep
+ StScratchWord i -> text "ScratchWord" <> paren (int i)
+
+pprPrimRep = text . showPrimRep
\end{code}
Stix registers can have two forms. They {\em may} or {\em may not}
ppMId BaseReg = text "BaseReg"
-ppMId (VanillaReg kind n) = hcat [text "IntReg(", int (I# n), char ')']
+ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(", int (I# n), char ')']
ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')']
ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')']
-ppMId (LongReg kind n) = hcat [text "LongReg(", int (I# n), char ')']
+ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(", int (I# n), char ')']
ppMId Sp = text "Sp"
ppMId Su = text "Su"
ppMId SpLim = text "SpLim"
\begin{code}
module StixInteger (
gmpCompare,
+ gmpCompareInt,
gmpInteger2Int,
gmpInteger2Word,
- gmpNegate
+ gmpNegate
) where
#include "HsVersions.h"
import PrimOp ( PrimOp(..) )
import PrimRep ( PrimRep(..) )
import SMRep ( arrWordsHdrSize )
-import Stix ( sStLitLbl, StixTree(..), StixTreeList )
+import Stix ( sStLitLbl, StixTree(..), StixTreeList, arrWordsHS )
import UniqSupply ( returnUs, thenUs, UniqSM )
\end{code}
available. (See ``primOpHeapRequired.'')
\begin{code}
+stgArrWords__words :: StixTree -> StixTree
+stgArrWords__BYTE_ARR_CTS :: StixTree -> StixTree
+
+stgArrWords__BYTE_ARR_CTS arr
+ = StIndex WordRep arr arrWordsHS
+stgArrWords__words arr
+ = case arrWordsHS of
+ StInt i -> StInd WordRep (StIndex PtrRep arr (StInt (i-1)))
+
gmpCompare
:: CAddrMode -- result (boolean)
- -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
- -- alloc hp + 2 arguments (3 parts each)
+ -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+ -- alloc hp + 2 arguments (2 parts each)
-> UniqSM StixTreeList
-gmpCompare res args@(caa1,csa1,cda1, caa2,csa2,cda2)
+gmpCompare res args@(csa1,cda1, csa2,cda2)
= let
result = amodeToStix res
- scratch1 = scratch_space
- scratch2 = StIndex IntRep scratch_space (StInt (toInteger mpIntSize))
- aa1 = amodeToStix caa1
sa1 = amodeToStix csa1
- da1 = amodeToStix cda1
- aa2 = amodeToStix caa2
sa2 = amodeToStix csa2
- da2 = amodeToStix cda2
+ aa1 = stgArrWords__words (amodeToStix cda1)
+ aa2 = stgArrWords__words (amodeToStix cda2)
+ da1 = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
+ da2 = stgArrWords__BYTE_ARR_CTS (amodeToStix cda2)
(a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
(a4,a5,a6) = toStruct scratch2 (aa2,sa2,da2)
r1 = StAssign IntRep result mpz_cmp
in
returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
+
+
+gmpCompareInt
+ :: CAddrMode -- result (boolean)
+ -> (CAddrMode,CAddrMode,CAddrMode)
+ -> UniqSM StixTreeList -- alloc hp + 1 arg (??)
+
+gmpCompareInt res args@(csa1,cda1, cai)
+ = let
+ result = amodeToStix res
+ sa1 = amodeToStix csa1
+ aa1 = stgArrWords__words (amodeToStix cda1)
+ da1 = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
+ ai = amodeToStix cai
+ (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
+ mpz_cmp_si = StCall SLIT("mpz_cmp_si") cCallConv IntRep [scratch1, ai]
+ r1 = StAssign IntRep result mpz_cmp_si
+ in
+ returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
\end{code}
\begin{code}
gmpInteger2Int
:: CAddrMode -- result
- -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+ -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
-> UniqSM StixTreeList
-gmpInteger2Int res args@(caa,csa,cda)
+gmpInteger2Int res args@(csa,cda)
= let
result = amodeToStix res
- aa = amodeToStix caa
sa = amodeToStix csa
- da = amodeToStix cda
+ aa = stgArrWords__words (amodeToStix cda)
+ da = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
- (a1,a2,a3) = toStruct scratch_space (aa,sa,da)
- mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch_space]
+ (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
+ mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch1]
r1 = StAssign IntRep result mpz_get_si
in
returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
gmpInteger2Word
:: CAddrMode -- result
- -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+ -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
-> UniqSM StixTreeList
-gmpInteger2Word res args@(caa,csa,cda)
+gmpInteger2Word res args@(csa,cda)
= let
result = amodeToStix res
- aa = amodeToStix caa
sa = amodeToStix csa
- da = amodeToStix cda
+ aa = stgArrWords__words (amodeToStix cda)
+ da = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
- (a1,a2,a3) = toStruct scratch_space (aa,sa,da)
- mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch_space]
+ (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
+ mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch1]
r1 = StAssign WordRep result mpz_get_ui
in
returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
gmpNegate
- :: (CAddrMode,CAddrMode,CAddrMode) -- result
- -> (CAddrMode,CAddrMode,CAddrMode) -- argument (3 parts)
+ :: (CAddrMode,CAddrMode) -- result
+ -> (CAddrMode,CAddrMode) -- argument (2 parts)
-> UniqSM StixTreeList
-gmpNegate (rca, rcs, rcd) args@(ca, cs, cd)
+gmpNegate (rcs, rcd) args@(cs, cd)
= let
- a = amodeToStix ca
s = amodeToStix cs
- d = amodeToStix cd
- ra = amodeToStix rca
+ a = stgArrWords__words (amodeToStix cd)
+ d = stgArrWords__BYTE_ARR_CTS (amodeToStix cd)
rs = amodeToStix rcs
- rd = amodeToStix rcd
+ ra = stgArrWords__words (amodeToStix rcd)
+ rd = stgArrWords__BYTE_ARR_CTS (amodeToStix rcd)
a1 = StAssign IntRep ra a
a2 = StAssign IntRep rs (StPrim IntNegOp [s])
a3 = StAssign PtrRep rd d
= let
f1 = StAssign IntRep (mpAlloc str) alloc
f2 = StAssign IntRep (mpSize str) size
- f3 = StAssign PtrRep (mpData str)
- (StIndex PtrRep arr (StInt (toInteger arrWordsHdrSize)))
+ f3 = StAssign PtrRep (mpData str) arr
in
(f1, f2, f3)
-scratch_space = sStLitLbl SLIT("stg_scratch_space")
+scratch1 = StScratchWord 0
+scratch2 = StScratchWord mpIntSize
\end{code}
\begin{code}
-- NB: ordering of clauses somewhere driven by
-- the desire to getting sane patt-matching behavior
-primCode res@[ar,sr,dr] IntegerNegOp arg@[aa,sa,da]
- = gmpNegate (ar,sr,dr) (aa,sa,da)
-\end{code}
+primCode res@[sr,dr] IntegerNegOp arg@[sa,da]
+ = gmpNegate (sr,dr) (sa,da)
-\begin{code}
-primCode [res] IntegerCmpOp args@[aa1,sa1,da1, aa2,sa2,da2]
- = gmpCompare res (aa1,sa1,da1, aa2,sa2,da2)
+primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2]
+ = gmpCompare res (sa1,da1, sa2,da2)
+
+primCode [res] IntegerCmpIntOp args@[sa1,da1,ai]
+ = gmpCompareInt res (sa1,da1,ai)
-primCode [res] Integer2IntOp arg@[aa,sa,da]
- = gmpInteger2Int res (aa,sa,da)
+primCode [res] Integer2IntOp arg@[sa,da]
+ = gmpInteger2Int res (sa,da)
-primCode [res] Integer2WordOp arg@[aa,sa,da]
- = gmpInteger2Word res (aa,sa,da)
+primCode [res] Integer2WordOp arg@[sa,da]
+ = gmpInteger2Word res (sa,da)
primCode [res] Int2AddrOp [arg]
= simpleCoercion AddrRep res arg
off = charLikeSize * ord c
amodeToStix (CCharLike x)
- = StIndex PtrRep charLike off
+ = StIndex CharRep charLike off
where
off = StPrim IntMulOp [amodeToStix x, StInt (toInteger charLikeSize)]
projects / ghc-hetmet.git / commitdiff