--- /dev/null
+%
+% (c) The AQUA Project, Glasgow University, 1993-2000
+%
+\section[AsmAssemble]{Assemble instructions into memory}
+
+\begin{code}
+module AsmAssemble ( asmAssemble ) where
+
+#include "HsVersions.h"
+
+import MachMisc ( Instr(..) )
+--import PprMach ( pprInstr ) -- Just for debugging
+--import RegAllocInfo
+
+import FiniteMap ( FiniteMap, lookupFM, listToFM, filterFM )
+import Outputable
+import CLabel ( CLabel, pprCLabel, isAsmTemp )
+
+import Foreign ( Ptr, Word8, plusPtr, nullPtr, poke, mallocBytes )
+import List ( mapAccumL )
+\end{code}
+
+This is the generic assembler. It assembles code into memory, knowing
+not very much at all about instructions. For simplicity a 2 pass
+scheme is used.
+
+\begin{code}
+asmAssemble :: FiniteMap CLabel (Ptr Word8) -- incoming address map
+ -> [[Instr]] -- to assemble
+ -> IO (FiniteMap CLabel (Ptr Word8)) -- contribs to addr map
+asmAssemble in_map instrss
+ = do
+ -- FIRST PASS: find out the insn lengths
+ let instrs = concat instrss
+ let objects = map (assembleInstr nullPtr Nothing) instrs
+ -- Extract the (label,offset) pairs for any labels defined in it
+ let (tot_len, maybe_label_offsets)
+ = mapAccumL getOffset 0 (zip instrs objects)
+ -- Now we know the size of the output; malloc accordingly
+ base_addr
+ <- mallocBytes tot_len
+ -- Build an env to map all local labels to their addresses
+ let local_label_env
+ = listToFM [(lab, base_addr `plusPtr` off)
+ | Just (lab,off) <- maybe_label_offsets]
+
+ -- SECOND PASS: assemble for real
+ let find_label :: CLabel -> Ptr Word8
+ find_label lab
+ = case lookupFM local_label_env lab of
+ Just xx -> xx
+ Nothing -> case lookupFM in_map lab of
+ Just yy -> yy
+ Nothing -> pprPanic "asmAssemble1: can't find"
+ (pprCLabel lab)
+ let (_, final_bytess)
+ = mapAccumL (doOneInsn find_label) base_addr instrs
+
+ -- We now have the final bytes; blast 'em into memory
+ pokeList base_addr (concat final_bytess)
+
+ -- Remove labels of only local scope from the local label env
+ let clean_label_env
+ = filterFM (\k e -> not (isAsmTemp k)) local_label_env
+
+ return clean_label_env
+
+pokeList :: Ptr Word8 -> [Word8] -> IO ()
+pokeList addr [] = return ()
+pokeList addr (b:bs) = poke addr b >> pokeList (addr `plusPtr` 1) bs
+
+
+
+doOneInsn :: (CLabel -> Ptr Word8) -> Ptr Word8 -> Instr -> (Ptr Word8, [Word8])
+doOneInsn find_label addr insn
+ = let bytes = assembleInstr addr (Just find_label) insn
+ in (addr `plusPtr` (length bytes), bytes)
+
+
+getOffset :: Int -> (Instr,[Word8]) -> (Int, Maybe (CLabel,Int))
+getOffset curr_off (LABEL l, bytes)
+ = (curr_off + length bytes, Just (l, curr_off))
+getOffset curr_off (not_label, bytes)
+ = (curr_off + length bytes, Nothing)
+
+
+assembleInstr :: Ptr Word8 -> Maybe (CLabel -> Ptr Word8) -> Instr -> [Word8]
+assembleInstr = undefined
+\end{code}
--- /dev/null
+%
+% (c) The AQUA Project, Glasgow University, 1996-1998
+%
+\section[AssembleInfo]{Machine-specific info used for assembly}
+
+The (machine-independent) assembler itself is in @AsmAssemble@.
+
+\begin{code}
+#include "nativeGen/NCG.h"
+
+module AssembleInfo ( assembleInstr ) where
+
+#include "HsVersions.h"
+
+import MachMisc
+import CLabel ( CLabel )
+import Outputable
+import Foreign ( Word8, Ptr )
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{@assembleInstr@; generate bytes for an insn}
+%* *
+%************************************************************************
+
+@assembleInstr@ returns the bytes (Word8's) for a given instruction.
+It takes the address where the instruction is to be placed, and an
+environment mapping C labels to addresses. The latter two are needed
+for calculating address offsets in call, jump, etc, instructions.
+The mapping can be a Nothing, indicating that the caller doesn't care
+what the resulting offsets are. If that's so, @assembleInstr@ is
+being called as the first pass of 2-pass assembly. For the final
+pass, the correct mapping (and base address) must of course be
+supplied.
+
+\begin{code}
+
+assembleInstr :: Ptr Word8 -> Maybe (CLabel -> Ptr Word8) -> Instr -> [Word8]
+
+#if alpha_TARGET_ARCH
+assembleInstr base_addr label_map instr
+ = panic "assembleInstr(Alpha)"
+#endif {- alpha_TARGET_ARCH -}
+assembleInstr base_addr label_map instr
+ = panic "assembleInstr(Alpha)"
+#if sparc_TARGET_ARCH
+#endif {- sparc_TARGET_ARCH -}
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#if i386_TARGET_ARCH
+assembleInstr base_addr label_map instr = case instr of
+ _ -> []
+
+#if 0
+ MOV sz src dst -> usageRW src dst
+ MOVZxL sz src dst -> usageRW src dst
+ MOVSxL sz src dst -> usageRW src dst
+ LEA sz src dst -> usageRW src dst
+ ADD sz src dst -> usageRM src dst
+ SUB sz src dst -> usageRM src dst
+ IMUL sz src dst -> usageRM src dst
+ IQUOT sz src dst -> usageRM src dst
+ IREM sz src dst -> usageRM src dst
+ AND sz src dst -> usageRM src dst
+ OR sz src dst -> usageRM src dst
+ XOR sz src dst -> usageRM src dst
+ NOT sz op -> usageM op
+ NEGI sz op -> usageM op
+ SHL sz imm dst -> usageM dst
+ SAR sz imm dst -> usageM dst
+ SHR sz imm dst -> usageM dst
+ BT sz imm src -> mkRU (use_R src) []
+
+ PUSH sz op -> mkRU (use_R op) []
+ POP sz op -> mkRU [] (def_W op)
+ TEST sz src dst -> mkRU (use_R src ++ use_R dst) []
+ CMP sz src dst -> mkRU (use_R src ++ use_R dst) []
+ SETCC cond op -> mkRU [] (def_W op)
+ JXX cond lbl -> mkRU [] []
+ JMP dsts op -> mkRU (use_R op) []
+ CALL imm -> mkRU [] callClobberedRegs
+ CLTD -> mkRU [eax] [edx]
+ NOP -> mkRU [] []
+
+ GMOV src dst -> mkRU [src] [dst]
+ GLD sz src dst -> mkRU (use_EA src) [dst]
+ GST sz src dst -> mkRU (src : use_EA dst) []
+
+ GLDZ dst -> mkRU [] [dst]
+ GLD1 dst -> mkRU [] [dst]
+
+ GFTOD src dst -> mkRU [src] [dst]
+ GFTOI src dst -> mkRU [src] [dst]
+
+ GDTOF src dst -> mkRU [src] [dst]
+ GDTOI src dst -> mkRU [src] [dst]
+
+ GITOF src dst -> mkRU [src] [dst]
+ GITOD src dst -> mkRU [src] [dst]
+
+ GADD sz s1 s2 dst -> mkRU [s1,s2] [dst]
+ GSUB sz s1 s2 dst -> mkRU [s1,s2] [dst]
+ GMUL sz s1 s2 dst -> mkRU [s1,s2] [dst]
+ GDIV sz s1 s2 dst -> mkRU [s1,s2] [dst]
+
+ GCMP sz src1 src2 -> mkRU [src1,src2] []
+ GABS sz src dst -> mkRU [src] [dst]
+ GNEG sz src dst -> mkRU [src] [dst]
+ GSQRT sz src dst -> mkRU [src] [dst]
+ GSIN sz src dst -> mkRU [src] [dst]
+ GCOS sz src dst -> mkRU [src] [dst]
+ GTAN sz src dst -> mkRU [src] [dst]
+
+ COMMENT _ -> noUsage
+ SEGMENT _ -> noUsage
+ LABEL _ -> noUsage
+ ASCII _ _ -> noUsage
+ DATA _ _ -> noUsage
+ DELTA _ -> noUsage
+ _ -> pprPanic "regUsage(x86)" empty
+#endif
+
+#endif {- i386_TARGET_ARCH -}
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+\end{code}
projects / ghc-hetmet.git / commitdiff