From 3a481f5449f5e5523ac20917f2b723daa1fbad2f Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 22 Nov 2000 16:58:31 +0000 Subject: [PATCH] [project @ 2000-11-22 16:58:31 by sewardj] Infrastructure for the (machine-independent) assembler. --- ghc/compiler/nativeGen/AsmAssemble.lhs | 89 ++++++++++++++++++++++ ghc/compiler/nativeGen/AssembleInfo.lhs | 125 +++++++++++++++++++++++++++++++ 2 files changed, 214 insertions(+) create mode 100644 ghc/compiler/nativeGen/AsmAssemble.lhs create mode 100644 ghc/compiler/nativeGen/AssembleInfo.lhs diff --git a/ghc/compiler/nativeGen/AsmAssemble.lhs b/ghc/compiler/nativeGen/AsmAssemble.lhs new file mode 100644 index 0000000..f5ff6d9 --- /dev/null +++ b/ghc/compiler/nativeGen/AsmAssemble.lhs @@ -0,0 +1,89 @@ +% +% (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} diff --git a/ghc/compiler/nativeGen/AssembleInfo.lhs b/ghc/compiler/nativeGen/AssembleInfo.lhs new file mode 100644 index 0000000..b63884a --- /dev/null +++ b/ghc/compiler/nativeGen/AssembleInfo.lhs @@ -0,0 +1,125 @@ +% +% (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} -- 1.7.10.4