Commit 00f44fdc authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove a use of cTargetOS, in favour of platformOS

parent 78fe515a
......@@ -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)
......
......@@ -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
-- -----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment