From 00f44fdc013f29c645d2b69ac5614c2af2a76c7e Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 8 May 2011 11:41:34 +0100 Subject: [PATCH] Remove a use of cTargetOS, in favour of platformOS --- compiler/ghci/ByteCodeAsm.lhs | 29 +++++++++++++++-------------- compiler/ghci/ByteCodeGen.lhs | 4 ++-- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 2c7473b..af9fbe9 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -30,8 +30,9 @@ import PrimOp import Constants import FastString import SMRep +import DynFlags import Outputable -import Config +import Platform import Control.Monad ( foldM ) import Control.Monad.ST ( runST ) @@ -45,7 +46,6 @@ import Data.Char ( ord ) import Data.List import Data.Map (Map) import qualified Data.Map as Map -import Distribution.System import GHC.Base ( ByteArray#, MutableByteArray#, RealWorld ) @@ -115,14 +115,14 @@ instance Outputable UnlinkedBCO where -- bytecode address in this BCO. -- Top level assembler fn. -assembleBCOs :: [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode -assembleBCOs proto_bcos tycons +assembleBCOs :: DynFlags -> [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode +assembleBCOs dflags proto_bcos tycons = do itblenv <- mkITbls tycons - bcos <- mapM assembleBCO proto_bcos + bcos <- mapM (assembleBCO dflags) proto_bcos return (ByteCode bcos itblenv) -assembleBCO :: ProtoBCO Name -> IO UnlinkedBCO -assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) +assembleBCO :: DynFlags -> ProtoBCO Name -> IO UnlinkedBCO +assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = let -- pass 1: collect up the offsets of the local labels. -- Remember that the first insn starts at offset @@ -154,7 +154,7 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) ptrs <- return emptySS :: IO (SizedSeq BCOPtr) let init_asm_state = (insns,lits,ptrs) (final_insns, final_lits, final_ptrs) - <- mkBits findLabel init_asm_state instrs + <- mkBits dflags findLabel init_asm_state instrs let asm_insns = ssElts final_insns n_insns = sizeSS final_insns @@ -230,12 +230,13 @@ largeArg w | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?" -- This is where all the action is (pass 2 of the assembler) -mkBits :: (Word16 -> Word) -- label finder +mkBits :: DynFlags + -> (Word16 -> Word) -- label finder -> AsmState -> [BCInstr] -- instructions (in) -> IO AsmState -mkBits findLabel st proto_insns +mkBits dflags findLabel st proto_insns = foldM doInstr st proto_insns where doInstr :: AsmState -> BCInstr -> IO AsmState @@ -249,14 +250,14 @@ mkBits findLabel st proto_insns instr2 st2 bci_PUSH_G p PUSH_PRIMOP op -> do (p, st2) <- ptr st (BCOPtrPrimOp op) instr2 st2 bci_PUSH_G p - PUSH_BCO proto -> do ul_bco <- assembleBCO proto + PUSH_BCO proto -> do ul_bco <- assembleBCO dflags proto (p, st2) <- ptr st (BCOPtrBCO ul_bco) instr2 st2 bci_PUSH_G p - PUSH_ALTS proto -> do ul_bco <- assembleBCO proto + PUSH_ALTS proto -> do ul_bco <- assembleBCO dflags proto (p, st2) <- ptr st (BCOPtrBCO ul_bco) instr2 st2 bci_PUSH_ALTS p PUSH_ALTS_UNLIFTED proto pk -> do - ul_bco <- assembleBCO proto + ul_bco <- assembleBCO dflags proto (p, st2) <- ptr st (BCOPtrBCO ul_bco) instr2 st2 (push_alts pk) p PUSH_UBX (Left lit) nws @@ -398,7 +399,7 @@ mkBits findLabel st proto_insns return (sizeSS16 st_l0, (st_i0,st_l1,st_p0)) literal st (MachLabel fs (Just sz) _) - | cTargetOS == Windows + | platformOS (targetPlatform dflags) == OSMinGW32 = litlabel st (appendFS fs (mkFastString ('@':show sz))) -- On Windows, stdcall labels have a suffix indicating the no. of -- arg words, e.g. foo@8. testcase: ffi012(ghci) diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 9308409..b888747 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -85,7 +85,7 @@ byteCodeGen dflags binds tycs modBreaks dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos))) - assembleBCOs proto_bcos tycs + assembleBCOs dflags proto_bcos tycs -- ----------------------------------------------------------------------------- -- Generating byte code for an expression @@ -114,7 +114,7 @@ coreExprToBCOs dflags expr dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" (ppr proto_bco) - assembleBCO proto_bco + assembleBCO dflags proto_bco -- ----------------------------------------------------------------------------- -- 1.7.10.4