ghc/compiler/nativeGen/AsmAssemble.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-2000
   3 %
   4 \section[AsmAssemble]{Assemble instructions into memory}
   5
   6 \begin{code}
   7 module AsmAssemble ( asmAssemble ) where
   8
   9 #include "HsVersions.h"
  10
  11 import MachMisc         ( Instr(..) )
  12 --import PprMach                ( pprInstr )    -- Just for debugging
  13 --import RegAllocInfo
  14
  15 import FiniteMap        ( FiniteMap, lookupFM, listToFM, filterFM )
  16 import Outputable
  17 import CLabel           ( CLabel, pprCLabel, isAsmTemp )
  18
  19 import Foreign          ( Ptr, Word8, plusPtr, nullPtr, poke, mallocBytes )
  20 import List             ( mapAccumL )
  21 \end{code}
  22
  23 This is the generic assembler.  It assembles code into memory, knowing
  24 not very much at all about instructions.  For simplicity a 2 pass
  25 scheme is used.
  26
  27 \begin{code}
  28 asmAssemble :: FiniteMap CLabel (Ptr Word8)             -- incoming address map
  29             -> [[Instr]]                                -- to assemble
  30             -> IO (FiniteMap CLabel (Ptr Word8))        -- contribs to addr map
  31 asmAssemble in_map instrss
  32    = do
  33         -- FIRST PASS: find out the insn lengths
  34         let instrs = concat instrss
  35         let objects = map (assembleInstr nullPtr Nothing) instrs
  36         -- Extract the (label,offset) pairs for any labels defined in it
  37         let (tot_len, maybe_label_offsets)
  38                 = mapAccumL getOffset 0 (zip instrs objects)
  39         -- Now we know the size of the output; malloc accordingly
  40         base_addr
  41            <- mallocBytes tot_len
  42         -- Build an env to map all local labels to their addresses
  43         let local_label_env
  44                = listToFM [(lab, base_addr `plusPtr` off)
  45                             | Just (lab,off) <- maybe_label_offsets]
  46
  47         -- SECOND PASS: assemble for real
  48         let find_label :: CLabel -> Ptr Word8
  49             find_label lab
  50                = case lookupFM local_label_env lab of
  51                     Just xx -> xx
  52                     Nothing -> case lookupFM in_map lab of
  53                                   Just yy -> yy
  54                                   Nothing -> pprPanic "asmAssemble1: can't find"
  55                                                       (pprCLabel lab)
  56         let (_, final_bytess)
  57                = mapAccumL (doOneInsn find_label) base_addr instrs
  58
  59         -- We now have the final bytes; blast 'em into memory
  60         pokeList base_addr (concat final_bytess)
  61
  62         -- Remove labels of only local scope from the local label env
  63         let clean_label_env
  64                = filterFM (\k e -> not (isAsmTemp k)) local_label_env
  65
  66         return clean_label_env
  67
  68 pokeList :: Ptr Word8 -> [Word8] -> IO ()
  69 pokeList addr []     = return ()
  70 pokeList addr (b:bs) = poke addr b >> pokeList (addr `plusPtr` 1) bs
  71
  72
  73
  74 doOneInsn :: (CLabel -> Ptr Word8) -> Ptr Word8 -> Instr -> (Ptr Word8, [Word8])
  75 doOneInsn find_label addr insn
  76    = let bytes = assembleInstr addr (Just find_label) insn
  77      in  (addr `plusPtr` (length bytes), bytes)
  78
  79
  80 getOffset :: Int -> (Instr,[Word8]) -> (Int, Maybe (CLabel,Int))
  81 getOffset curr_off (LABEL l, bytes)
  82   = (curr_off + length bytes, Just (l, curr_off))
  83 getOffset  curr_off (not_label, bytes)
  84   = (curr_off + length bytes, Nothing)
  85
  86
  87 assembleInstr :: Ptr Word8 -> Maybe (CLabel -> Ptr Word8) -> Instr -> [Word8]
  88 assembleInstr = undefined
  89 \end{code}