Commit 5819de0c authored by wolfgang's avatar wolfgang
Browse files

[project @ 2003-02-11 11:53:51 by wolfgang]

Mac OS X:
Add support for dynamic linker "symbol stubs". For every function that might
be imported from a dynamic library, we have to generate a short piece of
assembly code.
Extend the NatM monad to keep track of the list of imports (for which stubs
will be generated later).
Fix a bug concerning 64 bit ints (hi and low words were swapped in one place).
parent 2ae353a8
......@@ -25,11 +25,16 @@ import Stix ( StixReg(..), StixStmt(..), StixExpr(..), StixVReg(..),
liftStrings,
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
......@@ -92,13 +97,22 @@ So, here we go:
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
#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 (
......@@ -118,18 +132,18 @@ nativeCodeGen absC us
(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
......@@ -157,16 +171,17 @@ Switching between the two monads whilst carrying along the same Unique
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}
......
......@@ -41,6 +41,7 @@ import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..),
NatM, thenNat, returnNat, mapNat,
mapAndUnzipNat, mapAccumLNat,
getDeltaNat, setDeltaNat, getUniqueNat,
IF_OS_darwin(addImportNat COMMA,)
ncgPrimopMoan,
ncg_target_is_32bit
)
......@@ -512,8 +513,8 @@ iselExpr64 (StCall fn cconv kind args)
= genCCall fn cconv kind args `thenNat` \ call ->
getNewRegNCG IntRep `thenNat` \ r_dst_lo ->
let r_dst_hi = getHiVRegFromLo r_dst_lo
mov_lo = MR r_dst_lo r3
mov_hi = MR r_dst_hi r4
mov_lo = MR r_dst_lo r4
mov_hi = MR r_dst_hi r3
in
returnNat (
ChildCode64 (call `snocOL` mov_hi `snocOL` mov_lo)
......@@ -3491,8 +3492,14 @@ genCCall fn cconv kind args
`appOL` moveFinalCode
in
case fn of
Left lbl -> returnNat ( passArguments
`snocOL` BL (ImmLab False (ftext lbl)) usedRegs
Left lbl ->
addImportNat lbl `thenNat` \ _ ->
returnNat (passArguments
`snocOL` BL (ImmLit $ ftext
(FSLIT("L_")
`appendFS` lbl
`appendFS` FSLIT("$stub")))
usedRegs
`appOL` move_sp_up)
Right dyn ->
getRegister dyn `thenNat` \ dynReg ->
......
......@@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality
\begin{code}
#include "nativeGen/NCG.h"
module PprMach ( pprInstr, pprSize, pprUserReg ) where
module PprMach ( pprInstr, pprSize, pprUserReg IF_OS_darwin(COMMA pprDyldSymbolStub, ) ) where
#include "HsVersions.h"
......@@ -2037,6 +2037,34 @@ pprRI (RIImm r) = pprImm r
pprFSize DF = empty
pprFSize F = char 's'
{-
The Mach-O object file format used in Darwin/Mac OS X needs a so-called
"symbol stub" for every function that might be imported from a dynamic
library.
The stubs are always the same, and they are all output at the end of the
generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
Instead, we just pretty-print it directly.
-}
#if darwin_TARGET_OS
pprDyldSymbolStub fn =
vcat [
ptext SLIT(".symbol_stub"),
ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"),
ptext SLIT("\t.indirect_symbol _") <> ftext fn,
ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"),
ptext SLIT("\tmtctr r12"),
ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
ptext SLIT("\tbctr"),
ptext SLIT(".lazy_symbol_pointer"),
ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"),
ptext SLIT("\t.indirect_symbol _") <> ftext fn,
ptext SLIT("\t.long dyld_stub_binding_helper")
]
#endif
#endif {-powerpc_TARGET_ARCH-}
\end{code}
......
......@@ -21,7 +21,8 @@ module Stix (
mapNat, mapAndUnzipNat, mapAccumLNat,
getUniqueNat, getDeltaNat, setDeltaNat,
NatM_State, mkNatM_State,
uniqOfNatM_State, deltaOfNatM_State,
uniqOfNatM_State, deltaOfNatM_State, importsOfNatM_State,
addImportNat,
getUniqLabelNCG, getNatLabelNCG,
ncgPrimopMoan,
......@@ -527,16 +528,20 @@ liftStrings_wrk [] acc_stix acc_strs
The NCG's monad.
The monad keeps a UniqSupply, the current stack delta and
a list of imported entities, which is only used for
Darwin (Mac OS X).
\begin{code}
data NatM_State = NatM_State UniqSupply Int
data NatM_State = NatM_State UniqSupply Int [FastString]
type NatM result = NatM_State -> (result, NatM_State)
mkNatM_State :: UniqSupply -> Int -> NatM_State
mkNatM_State = NatM_State
uniqOfNatM_State (NatM_State us delta) = us
deltaOfNatM_State (NatM_State us delta) = delta
mkNatM_State us delta = NatM_State us delta []
uniqOfNatM_State (NatM_State us delta imports) = us
deltaOfNatM_State (NatM_State us delta imports) = delta
importsOfNatM_State (NatM_State us delta imports) = imports
initNat :: NatM_State -> NatM a -> (a, NatM_State)
initNat init_st m = case m init_st of { (r,st) -> (r,st) }
......@@ -576,17 +581,21 @@ mapAccumLNat f b (x:xs)
getUniqueNat :: NatM Unique
getUniqueNat (NatM_State us delta)
getUniqueNat (NatM_State us delta imports)
= case splitUniqSupply us of
(us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta))
(us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports))
getDeltaNat :: NatM Int
getDeltaNat st@(NatM_State us delta)
getDeltaNat st@(NatM_State us delta imports)
= (delta, st)
setDeltaNat :: Int -> NatM ()
setDeltaNat delta (NatM_State us _)
= ((), NatM_State us delta)
setDeltaNat delta (NatM_State us _ imports)
= ((), NatM_State us delta imports)
addImportNat :: FastString -> NatM ()
addImportNat imp (NatM_State us delta imports)
= ((), NatM_State us delta (imp:imports))
\end{code}
Giving up in a not-too-inelegant way.
......
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