#include "HsVersions.h"
#include "NCG.h"
-import List ( intersperse )
-
import MachMisc
import MachRegs
import MachCode
import PprMach
import AbsCStixGen ( genCodeAbstractC )
-import AbsCSyn ( AbstractC )
+import AbsCSyn ( AbstractC, MagicId(..) )
import AbsCUtils ( mkAbsCStmtList, magicIdPrimRep )
import AsmRegAlloc ( runRegAllocate )
import MachOp ( MachOp(..), isCommutableMachOp, isComparisonMachOp )
pprStixStmts, pprStixStmt,
stixStmt_CountTempUses, stixStmt_Subst,
liftStrings,
- initNat, mapNat,
+ initNat,
mkNatM_State,
- uniqOfNatM_State, deltaOfNatM_State )
+ uniqOfNatM_State, deltaOfNatM_State,
+ importsOfNatM_State )
import UniqSupply ( returnUs, thenUs, initUs,
UniqSM, UniqSupply,
lazyMapUs )
import MachMisc ( IF_ARCH_i386(i386_insert_ffrees,) )
+#if darwin_TARGET_OS
+import PprMach ( pprDyldSymbolStub )
+import List ( group, sort )
+#endif
import qualified Pretty
import Outputable
+import FastString
-- DEBUGGING ONLY
--import OrdList
+
+import List ( intersperse )
\end{code}
The 96/03 native-code generator has machine-independent and
This module (@AsmCodeGen@) is the top-level machine-independent
module. It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
-(defined in module @Stix@), using support code from @StixInfo@ (info
-tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
-macros), and @StixInteger@ (GMP arbitrary-precision operations).
+(defined in module @Stix@), using support code from @StixPrim@
+(primitive operations), @StixMacro@ (Abstract C macros), and
+@StixInteger@ (GMP arbitrary-precision operations).
Before entering machine-dependent land, we do some machine-independent
@genericOpt@imisations (defined below) on the @StixTree@s.
nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, Pretty.Doc)
nativeCodeGen absC us
= let absCstmts = mkAbsCStmtList absC
- (sdoc_pairs, us1) = initUs us (lazyMapUs absCtoNat absCstmts)
- stix_sdocs = map fst sdoc_pairs
- insn_sdocs = map snd sdoc_pairs
+ (results, us1) = initUs us (lazyMapUs absCtoNat absCstmts)
+ stix_sdocs = [ stix | (stix, insn, imports) <- results ]
+ insn_sdocs = [ insn | (stix, insn, imports) <- results ]
+ imports = [ imports | (stix, insn, imports) <- results ]
- insn_sdoc = my_vcat insn_sdocs
+ insn_sdoc = my_vcat insn_sdocs IF_OS_darwin(Pretty.$$ dyld_stubs,)
stix_sdoc = vcat stix_sdocs
-# ifdef NCG_DEBUG */
+#if darwin_TARGET_OS
+ -- Generate "symbol stubs" for all external symbols that might
+ -- come from a dynamic library.
+
+ dyld_stubs = Pretty.vcat $ map pprDyldSymbolStub $
+ map head $ group $ sort $ concat imports
+#endif
+
+# ifdef NCG_DEBUG
my_trace m x = trace m x
my_vcat sds = Pretty.vcat (
intersperse (
(stix_sdoc, insn_sdoc)
-absCtoNat :: AbstractC -> UniqSM (SDoc, Pretty.Doc)
+absCtoNat :: AbstractC -> UniqSM (SDoc, Pretty.Doc, [FastString])
absCtoNat absC
= _scc_ "genCodeAbstractC" genCodeAbstractC absC `thenUs` \ stixRaw ->
_scc_ "genericOpt" genericOpt stixRaw `bind` \ stixOpt ->
_scc_ "liftStrings" liftStrings stixOpt `thenUs` \ stixLifted ->
- _scc_ "genMachCode" genMachCode stixLifted `thenUs` \ pre_regalloc ->
+ _scc_ "genMachCode" genMachCode stixLifted `thenUs` \ (pre_regalloc, imports) ->
_scc_ "regAlloc" regAlloc pre_regalloc `bind` \ almost_final ->
_scc_ "x86fp_kludge" x86fp_kludge almost_final `bind` \ final_mach_code ->
_scc_ "vcat" Pretty.vcat (map pprInstr final_mach_code) `bind` \ final_sdoc ->
_scc_ "pprStixTrees" pprStixStmts stixOpt `bind` \ stix_sdoc ->
returnUs ({-\_ -> Pretty.vcat (map pprInstr almost_final),-}
- stix_sdoc, final_sdoc)
+ stix_sdoc, final_sdoc, imports)
where
bind f x = x f
supply breaks abstraction. Is that bad?
\begin{code}
-genMachCode :: [StixStmt] -> UniqSM InstrBlock
+genMachCode :: [StixStmt] -> UniqSM (InstrBlock, [FastString])
genMachCode stmts initial_us
= let initial_st = mkNatM_State initial_us 0
(instr_list, final_st) = initNat initial_st (stmtsToInstrs stmts)
final_us = uniqOfNatM_State final_st
final_delta = deltaOfNatM_State final_st
+ final_imports = importsOfNatM_State final_st
in
if final_delta == 0
- then (instr_list, final_us)
+ then ((instr_list, final_imports), final_us)
else pprPanic "genMachCode: nonzero final delta"
(int final_delta)
\end{code}
-> StAssignReg pk reg (stixExpr_ConFold src)
StAssignReg pk reg@(StixMagicId mid) src
-- Replace register leaves with appropriate StixTrees for
- -- the given target.
- -> case get_MagicId_reg_or_addr mid of
- Left realreg
- -> StAssignReg pk reg (stixExpr_ConFold src)
- Right baseRegAddr
- -> stixStmt_ConFold
- (StAssignMem pk baseRegAddr src)
+ -- the given target. MagicIds which map to a reg on this arch are left unchanged.
+ -- Assigning to BaseReg is always illegal, so we check for that.
+ -> case mid of {
+ BaseReg -> panic "stixStmt_ConFold: assignment to BaseReg";
+ other ->
+ case get_MagicId_reg_or_addr mid of
+ Left realreg
+ -> StAssignReg pk reg (stixExpr_ConFold src)
+ Right baseRegAddr
+ -> stixStmt_ConFold (StAssignMem pk baseRegAddr src)
+ }
StAssignMem pk addr src
-> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
- StAssignMachOp lhss mop args
- -> StAssignMachOp lhss mop (map stixExpr_ConFold args)
StVoidable expr
-> StVoidable (stixExpr_ConFold expr)
StJump dsts addr
-> let test_opt = stixExpr_ConFold test
in
if manifestlyZero test_opt
- then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+ then StComment (mkFastString ("deleted: " ++ showSDoc (pprStixStmt stmt)))
else StCondJump addr (stixExpr_ConFold test)
StData pk datas
-> StData pk (map stixExpr_ConFold datas)
-> stixMachOpFold mop (map stixExpr_ConFold args)
StReg (StixMagicId mid)
-- Replace register leaves with appropriate StixTrees for
- -- the given target.
+ -- the given target. MagicIds which map to a reg on this arch are left unchanged.
+ -- For the rest, BaseReg is taken to mean the address of the reg table
+ -- in MainCapability, and for all others we generate an indirection to
+ -- its location in the register table.
-> case get_MagicId_reg_or_addr mid of
Left realreg -> expr
Right baseRegAddr
- -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
+ -> case mid of
+ BaseReg -> stixExpr_ConFold baseRegAddr
+ other -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
other
-> other
\end{code}
projects / ghc-hetmet.git / blobdiff