diff options
Diffstat (limited to 'compiler/codeGen/StgCmmLayout.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmLayout.hs | 100 |
1 files changed, 51 insertions, 49 deletions
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index e20e4a29bd..142100e109 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -219,7 +219,7 @@ direct_call caller call_conv lbl arity args emitCallWithExtraStack (call_conv, NativeReturn) target (nonVArgs fast_args) - (mkStkOffsets (stack_args dflags)) + (mkStkOffsets dflags (stack_args dflags)) where target = CmmLit (CmmLabel lbl) (fast_args, rest_args) = splitAt real_arity args @@ -329,10 +329,11 @@ slowCallPattern [] = (fsLit "stg_ap_0", 0) -- See Note [over-saturated calls]. mkStkOffsets - :: [(ArgRep, Maybe CmmExpr)] -- things to make offsets for + :: DynFlags + -> [(ArgRep, Maybe CmmExpr)] -- things to make offsets for -> ( ByteOff -- OUTPUTS: Topmost allocated word , [(CmmExpr, ByteOff)] ) -- things with offsets (voids filtered out) -mkStkOffsets things +mkStkOffsets dflags things = loop 0 [] (reverse things) where loop offset offs [] = (offset,offs) @@ -341,7 +342,7 @@ mkStkOffsets things loop offset offs ((rep,Just thing):things) = loop thing_off ((thing, thing_off):offs) things where - thing_off = offset + argRepSizeW rep * wORD_SIZE + thing_off = offset + argRepSizeW dflags rep * wORD_SIZE dflags -- offset of thing is offset+size, because we're -- growing the stack *downwards* as the offsets increase. @@ -382,13 +383,13 @@ isNonV :: ArgRep -> Bool isNonV V = False isNonV _ = True -argRepSizeW :: ArgRep -> WordOff -- Size in words -argRepSizeW N = 1 -argRepSizeW P = 1 -argRepSizeW F = 1 -argRepSizeW L = wORD64_SIZE `quot` wORD_SIZE -argRepSizeW D = dOUBLE_SIZE `quot` wORD_SIZE -argRepSizeW V = 0 +argRepSizeW :: DynFlags -> ArgRep -> WordOff -- Size in words +argRepSizeW _ N = 1 +argRepSizeW _ P = 1 +argRepSizeW _ F = 1 +argRepSizeW dflags L = wORD64_SIZE `quot` wORD_SIZE dflags +argRepSizeW dflags D = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags +argRepSizeW _ V = 0 idArgRep :: Id -> ArgRep idArgRep = toArgRep . idPrimRep @@ -405,8 +406,9 @@ hpRel hp off = off - hp getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr getHpRelOffset virtual_offset - = do { hp_usg <- getHpUsage - ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) } + = do dflags <- getDynFlags + hp_usg <- getHpUsage + return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset)) mkVirtHeapOffsets :: DynFlags @@ -438,7 +440,7 @@ mkVirtHeapOffsets dflags is_thunk things | otherwise = fixedHdrSize dflags computeOffset wds_so_far (rep, thing) - = (wds_so_far + argRepSizeW (toArgRep rep), + = (wds_so_far + argRepSizeW dflags (toArgRep rep), (NonVoid thing, hdr_size + wds_so_far)) mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)]) @@ -462,19 +464,20 @@ mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False #include "../includes/rts/storage/FunTypes.h" mkArgDescr :: Name -> [Id] -> FCode ArgDescr -mkArgDescr _nm args - = case stdPattern arg_reps of - Just spec_id -> return (ArgSpec spec_id) - Nothing -> return (ArgGen arg_bits) - where - arg_bits = argBits arg_reps - arg_reps = filter isNonV (map idArgRep args) - -- Getting rid of voids eases matching of standard patterns - -argBits :: [ArgRep] -> [Bool] -- True for non-ptr, False for ptr -argBits [] = [] -argBits (P : args) = False : argBits args -argBits (arg : args) = take (argRepSizeW arg) (repeat True) ++ argBits args +mkArgDescr _nm args + = do dflags <- getDynFlags + let arg_bits = argBits dflags arg_reps + arg_reps = filter isNonV (map idArgRep args) + -- Getting rid of voids eases matching of standard patterns + case stdPattern arg_reps of + Just spec_id -> return (ArgSpec spec_id) + Nothing -> return (ArgGen arg_bits) + +argBits :: DynFlags -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr +argBits _ [] = [] +argBits dflags (P : args) = False : argBits dflags args +argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True) + ++ argBits dflags args ---------------------- stdPattern :: [ArgRep] -> Maybe StgHalfWord @@ -527,13 +530,12 @@ emitClosureProcAndInfoTable :: Bool -- top-level? -> ((Int, LocalReg, [LocalReg]) -> FCode ()) -- function body -> FCode () emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body - = do { + = do { dflags <- getDynFlags -- Bind the binder itself, but only if it's not a top-level -- binding. We need non-top let-bindings to refer to the -- top-level binding, which this binding would incorrectly shadow. - ; node <- if top_lvl then return $ idToReg (NonVoid bndr) + ; node <- if top_lvl then return $ idToReg dflags (NonVoid bndr) else bindToReg (NonVoid bndr) lf_info - ; dflags <- getDynFlags ; let node_points = nodeMustPointToIt dflags lf_info ; arg_regs <- bindArgsToRegs args ; let args' = if node_points then (node : arg_regs) else arg_regs @@ -571,7 +573,7 @@ stdInfoTableSizeW dflags | otherwise = 0 stdInfoTableSizeB :: DynFlags -> ByteOff -stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE :: ByteOff +stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags stdSrtBitmapOffset :: DynFlags -> ByteOff -- Byte offset of the SRT bitmap half-word which is @@ -580,11 +582,11 @@ stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE stdClosureTypeOffset :: DynFlags -> ByteOff -- Byte offset of the closure type half-word -stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE +stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff -stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE -stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE +stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags +stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE ------------------------------------------------------------------------- -- @@ -592,16 +594,16 @@ stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZ -- ------------------------------------------------------------------------- -closureInfoPtr :: CmmExpr -> CmmExpr +closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr -- Takes a closure pointer and returns the info table pointer -closureInfoPtr e = CmmLoad e bWord +closureInfoPtr dflags e = CmmLoad e (bWord dflags) entryCode :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info pointer (the first word of a closure) -- and returns its entry code entryCode dflags e | tablesNextToCode dflags = e - | otherwise = CmmLoad e bWord + | otherwise = CmmLoad e (bWord dflags) getConstrTag :: DynFlags -> CmmExpr -> CmmExpr -- Takes a closure pointer, and return the *zero-indexed* @@ -609,25 +611,25 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr -- This lives in the SRT field of the info table -- (constructors don't need SRTs). getConstrTag dflags closure_ptr - = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag dflags info_table] + = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableConstrTag dflags info_table] where - info_table = infoTable dflags (closureInfoPtr closure_ptr) + info_table = infoTable dflags (closureInfoPtr dflags closure_ptr) cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr -- Takes a closure pointer, and return the closure type -- obtained from the info table cmmGetClosureType dflags closure_ptr - = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType dflags info_table] + = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableClosureType dflags info_table] where - info_table = infoTable dflags (closureInfoPtr closure_ptr) + info_table = infoTable dflags (closureInfoPtr dflags closure_ptr) infoTable :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info pointer (the first word of a closure) -- and returns a pointer to the first word of the standard-form -- info table, excluding the entry-code word (if present) infoTable dflags info_ptr - | tablesNextToCode dflags = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags) - | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer + | tablesNextToCode dflags = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags) + | otherwise = cmmOffsetW dflags info_ptr 1 -- Past the entry code pointer infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info table pointer (from infoTable) and returns the constr tag @@ -638,21 +640,21 @@ infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info table pointer (from infoTable) and returns the srt_bitmap -- field of the info table infoTableSrtBitmap dflags info_tbl - = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord + = CmmLoad (cmmOffsetB dflags info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord dflags) infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info table pointer (from infoTable) and returns the closure type -- field of the info table. infoTableClosureType dflags info_tbl - = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) bHalfWord + = CmmLoad (cmmOffsetB dflags info_tbl (stdClosureTypeOffset dflags)) (bHalfWord dflags) infoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr infoTablePtrs dflags info_tbl - = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) bHalfWord + = CmmLoad (cmmOffsetB dflags info_tbl (stdPtrsOffset dflags)) (bHalfWord dflags) infoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr infoTableNonPtrs dflags info_tbl - = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord + = CmmLoad (cmmOffsetB dflags info_tbl (stdNonPtrsOffset dflags)) (bHalfWord dflags) funInfoTable :: DynFlags -> CmmExpr -> CmmExpr -- Takes the info pointer of a function, @@ -660,8 +662,8 @@ funInfoTable :: DynFlags -> CmmExpr -> CmmExpr -- in the info table. funInfoTable dflags info_ptr | tablesNextToCode dflags - = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev) + = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags) | otherwise - = cmmOffsetW info_ptr (1 + stdInfoTableSizeW dflags) + = cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags) -- Past the entry code pointer |