Skip to content

GitLab

GHC
GHC
Commit 9ee9e518 authored by dterei's avatar dterei
Browse files
Options

Formatting fixes

parent 74ac5be0
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 797 additions and 836 deletions
compiler/codeGen/CgCallConv.hs
View file @ 9ee9e518
......@@ -4,34 +4,27 @@
--
-- CgCallConv
--
-- The datatypes and functions here encapsulate the
-- The datatypes and functions here encapsulate the
-- calling and return conventions used by the code generator.
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CgCallConv (
-- Argument descriptors
mkArgDescr,
-- Argument descriptors
mkArgDescr,
-- Liveness
mkRegLiveness,
-- Liveness
mkRegLiveness,
-- Register assignment
assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
-- Register assignment
assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
-- Calls
constructSlowCall, slowArgs, slowCallPattern,
-- Calls
constructSlowCall, slowArgs, slowCallPattern,
-- Returns
dataReturnConvPrim,
getSequelAmode
-- Returns
dataReturnConvPrim,
getSequelAmode
) where
import CgMonad
......@@ -57,11 +50,11 @@ import Data.Bits
-------------------------------------------------------------------------
--
-- Making argument descriptors
-- Making argument descriptors
--
-- An argument descriptor describes the layout of args on the stack,
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
--
-- Void arguments aren't important, therefore (contrast constructSlowCall)
--
......@@ -72,29 +65,29 @@ import Data.Bits
-------------------------
mkArgDescr :: Name -> [Id] -> FCode ArgDescr
mkArgDescr _nm args
mkArgDescr _nm args
= case stdPattern arg_reps of
Just spec_id -> return (ArgSpec spec_id)
Nothing -> return (ArgGen arg_bits)
Just spec_id -> return (ArgSpec spec_id)
Nothing -> return (ArgGen arg_bits)
where
arg_bits = argBits arg_reps
arg_reps = filter nonVoidArg (map idCgRep args)
-- Getting rid of voids eases matching of standard patterns
-- Getting rid of voids eases matching of standard patterns
argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits [] = []
argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits [] = []
argBits (PtrArg : args) = False : argBits args
argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
stdPattern :: [CgRep] -> Maybe StgHalfWord
stdPattern [] = Just ARG_NONE -- just void args, probably
stdPattern [] = Just ARG_NONE -- just void args, probably
stdPattern [PtrArg] = Just ARG_P
stdPattern [FloatArg] = Just ARG_F
stdPattern [DoubleArg] = Just ARG_D
stdPattern [LongArg] = Just ARG_L
stdPattern [NonPtrArg] = Just ARG_N
stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
stdPattern [NonPtrArg,PtrArg] = Just ARG_NP
stdPattern [PtrArg,NonPtrArg] = Just ARG_PN
......@@ -103,13 +96,13 @@ stdPattern [PtrArg,PtrArg] = Just ARG_PP
stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
stdPattern [NonPtrArg,NonPtrArg,PtrArg] = Just ARG_NNP
stdPattern [NonPtrArg,PtrArg,NonPtrArg] = Just ARG_NPN
stdPattern [NonPtrArg,PtrArg,PtrArg] = Just ARG_NPP
stdPattern [NonPtrArg,PtrArg,PtrArg] = Just ARG_NPP
stdPattern [PtrArg,NonPtrArg,NonPtrArg] = Just ARG_PNN
stdPattern [PtrArg,NonPtrArg,PtrArg] = Just ARG_PNP
stdPattern [PtrArg,PtrArg,NonPtrArg] = Just ARG_PPN
stdPattern [PtrArg,PtrArg,PtrArg] = Just ARG_PPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPP
stdPattern [PtrArg,NonPtrArg,PtrArg] = Just ARG_PNP
stdPattern [PtrArg,PtrArg,NonPtrArg] = Just ARG_PPN
stdPattern [PtrArg,PtrArg,PtrArg] = Just ARG_PPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
stdPattern _ = Nothing
......@@ -117,17 +110,17 @@ stdPattern _ = Nothing
-------------------------------------------------------------------------
--
-- Bitmap describing register liveness
-- across GC when doing a "generic" heap check
-- (a RET_DYN stack frame).
-- Bitmap describing register liveness
-- across GC when doing a "generic" heap check
-- (a RET_DYN stack frame).
--
-- NB. Must agree with these macros (currently in StgMacros.h):
-- NB. Must agree with these macros (currently in StgMacros.h):
-- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
-------------------------------------------------------------------------
mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
mkRegLiveness regs ptrs nptrs
= (fromIntegral nptrs `shiftL` 16) .|.
= (fromIntegral nptrs `shiftL` 16) .|.
(fromIntegral ptrs `shiftL` 24) .|.
all_non_ptrs `xor` reg_bits regs
where
......@@ -135,31 +128,31 @@ mkRegLiveness regs ptrs nptrs
reg_bits [] = 0
reg_bits ((id, VanillaReg i _) : regs) | isFollowableArg (idCgRep id)
= (1 `shiftL` (i - 1)) .|. reg_bits regs
= (1 `shiftL` (i - 1)) .|. reg_bits regs
reg_bits (_ : regs)
= reg_bits regs
= reg_bits regs
-------------------------------------------------------------------------
--
-- Pushing the arguments for a slow call
-- Pushing the arguments for a slow call
--
-------------------------------------------------------------------------
-- For a slow call, we must take a bunch of arguments and intersperse
-- some stg_ap_<pattern>_ret_info return addresses.
constructSlowCall
:: [(CgRep,CmmExpr)]
-> (CLabel, -- RTS entry point for call
[(CgRep,CmmExpr)], -- args to pass to the entry point
[(CgRep,CmmExpr)]) -- stuff to save on the stack
:: [(CgRep,CmmExpr)]
-> (CLabel, -- RTS entry point for call
[(CgRep,CmmExpr)], -- args to pass to the entry point
[(CgRep,CmmExpr)]) -- stuff to save on the stack
-- don't forget the zero case
constructSlowCall []
constructSlowCall []
= (mkRtsApFastLabel (fsLit "stg_ap_0"), [], [])
constructSlowCall amodes
= (stg_ap_pat, these, rest)
where
where
stg_ap_pat = mkRtsApFastLabel arg_pat
(arg_pat, these, rest) = matchSlowPattern amodes
......@@ -178,33 +171,33 @@ slowArgs amodes
save_cccs = [(NonPtrArg, mkLblExpr save_cccs_lbl), (NonPtrArg, curCCS)]
save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
matchSlowPattern :: [(CgRep,CmmExpr)]
-> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
matchSlowPattern :: [(CgRep,CmmExpr)]
-> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
matchSlowPattern amodes = (arg_pat, these, rest)
where (arg_pat, n) = slowCallPattern (map fst amodes)
(these, rest) = splitAt n amodes
(these, rest) = splitAt n amodes
-- These cases were found to cover about 99% of all slow calls:
slowCallPattern :: [CgRep] -> (FastString, Int)
slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6)
slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppppp", 5)
slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppp", 4)
slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_pppv", 4)
slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppp", 3)
slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_ppv", 3)
slowCallPattern (PtrArg: PtrArg: _) = (fsLit "stg_ap_pp", 2)
slowCallPattern (PtrArg: VoidArg: _) = (fsLit "stg_ap_pv", 2)
slowCallPattern (PtrArg: _) = (fsLit "stg_ap_p", 1)
slowCallPattern (VoidArg: _) = (fsLit "stg_ap_v", 1)
slowCallPattern (NonPtrArg: _) = (fsLit "stg_ap_n", 1)
slowCallPattern (FloatArg: _) = (fsLit "stg_ap_f", 1)
slowCallPattern (DoubleArg: _) = (fsLit "stg_ap_d", 1)
slowCallPattern (LongArg: _) = (fsLit "stg_ap_l", 1)
slowCallPattern _ = panic "CgStackery.slowCallPattern"
slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppppp", 5)
slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppp", 4)
slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_pppv", 4)
slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppp", 3)
slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_ppv", 3)
slowCallPattern (PtrArg: PtrArg: _) = (fsLit "stg_ap_pp", 2)
slowCallPattern (PtrArg: VoidArg: _) = (fsLit "stg_ap_pv", 2)
slowCallPattern (PtrArg: _) = (fsLit "stg_ap_p", 1)
slowCallPattern (VoidArg: _) = (fsLit "stg_ap_v", 1)
slowCallPattern (NonPtrArg: _) = (fsLit "stg_ap_n", 1)
slowCallPattern (FloatArg: _) = (fsLit "stg_ap_f", 1)
slowCallPattern (DoubleArg: _) = (fsLit "stg_ap_d", 1)
slowCallPattern (LongArg: _) = (fsLit "stg_ap_l", 1)
slowCallPattern _ = panic "CgStackery.slowCallPattern"
-------------------------------------------------------------------------
--
-- Return conventions
-- Return conventions
--
-------------------------------------------------------------------------
......@@ -219,7 +212,7 @@ dataReturnConvPrim VoidArg = panic "dataReturnConvPrim: void"
-- getSequelAmode returns an amode which refers to an info table. The info
-- table will always be of the RET_(BIG|SMALL) kind. We're careful
-- not to handle real code pointers, just in case we're compiling for
-- not to handle real code pointers, just in case we're compiling for
-- an unregisterised/untailcallish architecture, where info pointers and
-- code pointers aren't the same.
-- DIRE WARNING.
......@@ -230,60 +223,60 @@ dataReturnConvPrim VoidArg = panic "dataReturnConvPrim: void"
getSequelAmode :: FCode CmmExpr
getSequelAmode
= do { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
; case sequel of
OnStack -> do { sp_rel <- getSpRelOffset virt_sp
; returnFC (CmmLoad sp_rel bWord) }
= do { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
; case sequel of
OnStack -> do { sp_rel <- getSpRelOffset virt_sp
; returnFC (CmmLoad sp_rel bWord) }
CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
}
CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
}
-------------------------------------------------------------------------
--
-- Register assignment
-- Register assignment
--
-------------------------------------------------------------------------
-- How to assign registers for
-- How to assign registers for
--
-- 1) Calling a fast entry point.
-- 2) Returning an unboxed tuple.
-- 3) Invoking an out-of-line PrimOp.
-- 1) Calling a fast entry point.
-- 2) Returning an unboxed tuple.
-- 3) Invoking an out-of-line PrimOp.
--
-- Registers are assigned in order.
--
--
-- If we run out, we don't attempt to assign any further registers (even
-- though we might have run out of only one kind of register); we just
-- return immediately with the left-overs specified.
--
--
-- The alternative version @assignAllRegs@ uses the complete set of
-- registers, including those that aren't mapped to real machine
-- registers. This is used for calling special RTS functions and PrimOps
-- which expect their arguments to always be in the same registers.
assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
:: [(CgRep,a)] -- Arg or result values to assign
-> ([(a, GlobalReg)], -- Register assignment in same order
-- for *initial segment of* input list
-- (but reversed; doesn't matter)
-- VoidRep args do not appear here
[(CgRep,a)]) -- Leftover arg or result values
:: [(CgRep,a)] -- Arg or result values to assign
-> ([(a, GlobalReg)], -- Register assignment in same order
-- for *initial segment of* input list
-- (but reversed; doesn't matter)
-- VoidRep args do not appear here
[(CgRep,a)]) -- Leftover arg or result values
assignCallRegs args
= assign_regs args (mkRegTbl [node])
-- The entry convention for a function closure
-- never uses Node for argument passing; instead
-- Node points to the function closure itself
-- The entry convention for a function closure
-- never uses Node for argument passing; instead
-- Node points to the function closure itself
assignPrimOpCallRegs args
= assign_regs args (mkRegTbl_allRegs [])
-- For primops, *all* arguments must be passed in registers
-- For primops, *all* arguments must be passed in registers
assignReturnRegs args
-- when we have a single non-void component to return, use the normal
-- unpointed return convention. This make various things simpler: it
-- means we can assume a consistent convention for IO, which is useful
-- when writing code that relies on knowing the IO return convention in
-- when writing code that relies on knowing the IO return convention in
-- the RTS (primops, especially exception-related primops).
-- Also, the bytecode compiler assumes this when compiling
-- case expressions and ccalls, so it only needs to know one set of
......@@ -292,24 +285,24 @@ assignReturnRegs args
= ([(arg, r)], [])
| otherwise
= assign_regs args (mkRegTbl [])
-- For returning unboxed tuples etc,
-- we use all regs
where
-- For returning unboxed tuples etc,
-- we use all regs
where
non_void_args = filter ((/= VoidArg).fst) args
assign_regs :: [(CgRep,a)] -- Arg or result values to assign
-> AvailRegs -- Regs still avail: Vanilla, Float, Double, Longs
-> ([(a, GlobalReg)], [(CgRep, a)])
assign_regs :: [(CgRep,a)] -- Arg or result values to assign
-> AvailRegs -- Regs still avail: Vanilla, Float, Double, Longs
-> ([(a, GlobalReg)], [(CgRep, a)])
assign_regs args supply
= go args [] supply
where
go [] acc _ = (acc, []) -- Return the results reversed (doesn't matter)
go ((VoidArg,_) : args) acc supply -- Skip void arguments; they aren't passed, and
= go args acc supply -- there's nothing to bind them to
go ((rep,arg) : args) acc supply
= case assign_reg rep supply of
Just (reg, supply') -> go args ((arg,reg):acc) supply'
Nothing -> (acc, (rep,arg):args) -- No more regs
go [] acc _ = (acc, []) -- Return the results reversed (doesn't matter)
go ((VoidArg,_) : args) acc supply -- Skip void arguments; they aren't passed, and
= go args acc supply -- there's nothing to bind them to
go ((rep,arg) : args) acc supply
= case assign_reg rep supply of
Just (reg, supply') -> go args ((arg,reg):acc) supply'
Nothing -> (acc, (rep,arg):args) -- No more regs
assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
assign_reg FloatArg (vs, f:fs, ds, ls) = Just (FloatReg f, (vs, fs, ds, ls))
......@@ -323,7 +316,7 @@ assign_reg _ _ = Nothing
-------------------------------------------------------------------------
--
-- Register supplies
-- Register supplies
--
-------------------------------------------------------------------------
......@@ -335,37 +328,37 @@ assign_reg _ _ = Nothing
useVanillaRegs :: Int
useVanillaRegs | opt_Unregisterised = 0
| otherwise = mAX_Real_Vanilla_REG
| otherwise = mAX_Real_Vanilla_REG
useFloatRegs :: Int
useFloatRegs | opt_Unregisterised = 0
| otherwise = mAX_Real_Float_REG
| otherwise = mAX_Real_Float_REG
useDoubleRegs :: Int
useDoubleRegs | opt_Unregisterised = 0
| otherwise = mAX_Real_Double_REG
| otherwise = mAX_Real_Double_REG
useLongRegs :: Int
useLongRegs | opt_Unregisterised = 0
| otherwise = mAX_Real_Long_REG
| otherwise = mAX_Real_Long_REG
vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
vanillaRegNos = regList useVanillaRegs
floatRegNos = regList useFloatRegs
doubleRegNos = regList useDoubleRegs
vanillaRegNos = regList useVanillaRegs
floatRegNos = regList useFloatRegs
doubleRegNos = regList useDoubleRegs
longRegNos = regList useLongRegs
allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
allVanillaRegNos = regList mAX_Vanilla_REG
allFloatRegNos = regList mAX_Float_REG
allDoubleRegNos = regList mAX_Double_REG
allLongRegNos = regList mAX_Long_REG
allFloatRegNos = regList mAX_Float_REG
allDoubleRegNos = regList mAX_Double_REG
allLongRegNos = regList mAX_Long_REG
regList :: Int -> [Int]
regList n = [1 .. n]
type AvailRegs = ( [Int] -- available vanilla regs.
, [Int] -- floats
, [Int] -- doubles
, [Int] -- longs (int64 and word64)
)
, [Int] -- floats
, [Int] -- doubles
, [Int] -- longs (int64 and word64)
)
mkRegTbl :: [GlobalReg] -> AvailRegs
mkRegTbl regs_in_use
......@@ -381,23 +374,23 @@ mkRegTbl' regs_in_use vanillas floats doubles longs
= (ok_vanilla, ok_float, ok_double, ok_long)
where
ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr)) vanillas
-- ptrhood isn't looked at, hence we can use any old rep.
ok_float = mapCatMaybes (select FloatReg) floats
-- ptrhood isn't looked at, hence we can use any old rep.
ok_float = mapCatMaybes (select FloatReg) floats
ok_double = mapCatMaybes (select DoubleReg) doubles
ok_long = mapCatMaybes (select LongReg) longs
ok_long = mapCatMaybes (select LongReg) longs
select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
-- one we've unboxed the Int, we make a GlobalReg
-- and see if it is already in use; if not, return its number.
-- one we've unboxed the Int, we make a GlobalReg
-- and see if it is already in use; if not, return its number.
select mk_reg_fun cand
= let
reg = mk_reg_fun cand
in
if reg `not_elem` regs_in_use
then Just cand
else Nothing
reg = mk_reg_fun cand
in
if reg `not_elem` regs_in_use
then Just cand
else Nothing
where
not_elem = isn'tIn "mkRegTbl"
not_elem = isn'tIn "mkRegTbl"
compiler/codeGen/CgCase.lhs
View file @ 9ee9e518
This diff is collapsed.
compiler/codeGen/CgForeignCall.hs
View file @ 9ee9e518
......@@ -7,15 +7,15 @@
-----------------------------------------------------------------------------
module CgForeignCall (
cgForeignCall,
emitForeignCall,
emitForeignCall',
shimForeignCallArg,
emitSaveThreadState, -- will be needed by the Cmm parser
emitLoadThreadState, -- ditto
emitCloseNursery,
emitOpenNursery,
) where
cgForeignCall,
emitForeignCall,
emitForeignCall',
shimForeignCallArg,
emitSaveThreadState, -- will be needed by the Cmm parser
emitLoadThreadState, -- ditto
emitCloseNursery,
emitOpenNursery,
) where
import StgSyn
import CgProf
......
compiler/codeGen/CgPrimOp.hs
View file @ 9ee9e518
......@@ -6,16 +6,9 @@
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CgPrimOp (
cgPrimOp
) where
cgPrimOp
) where
import BasicTypes
import ForeignCall
......@@ -43,44 +36,44 @@ import StaticFlags
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
cgPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> Code
cgPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> Code
cgPrimOp results op args live
= do arg_exprs <- getArgAmodes args
let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
emitPrimOp results op non_void_args live
emitPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> Code
emitPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> Code
-- First we handle various awkward cases specially. The remaining
-- easy cases are then handled by translateOp, defined below.
emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
{-
{-
With some bit-twiddling, we can define int{Add,Sub}Czh portably in
C, and without needing any comparisons. This may not be the
fastest way to do it - if you have better code, please send it! --SDM
Return : r = a + b, c = 0 if no overflow, 1 on overflow.
We currently don't make use of the r value if c is != 0 (i.e.
We currently don't make use of the r value if c is != 0 (i.e.
overflow), we just convert to big integers and try again. This
could be improved by making r and c the correct values for
plugging into a new J#.
{ r = ((I_)(a)) + ((I_)(b)); \
c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
>> (BITS_IN (I_) - 1); \
}
plugging into a new J#.
{ r = ((I_)(a)) + ((I_)(b)); \
c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
>> (BITS_IN (I_) - 1); \
}
Wading through the mass of bracketry, it seems to reduce to:
c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
......@@ -88,22 +81,22 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
= stmtsC [
CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
CmmAssign (CmmLocal res_c) $
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
]
emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
{- Similarly:
#define subIntCzh(r,c,a,b) \
{ r = ((I_)(a)) - ((I_)(b)); \
c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
>> (BITS_IN (I_) - 1); \
#define subIntCzh(r,c,a,b) \
{ r = ((I_)(a)) - ((I_)(b)); \
c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
>> (BITS_IN (I_) - 1); \
}
c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
......@@ -111,27 +104,27 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
= stmtsC [
CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
CmmAssign (CmmLocal res_c) $
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordXor [aa,bb],
CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
CmmMachOp mo_wordUShr [
CmmMachOp mo_wordAnd [
CmmMachOp mo_wordXor [aa,bb],
CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
],
CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
]
]
emitPrimOp [res] ParOp [arg] live
= do
-- for now, just implement this in a C function
-- later, we might want to inline it.
-- for now, just implement this in a C function