-- This file is part of Bindings-bfd.
--
-- Copyright (C) 2010 Michael Nelson
--
-- Bindings-bfd is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Bindings-bfd is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.

-- You should have received a copy of the GNU Lesser General Public License
-- along with Bindings-bfd.  If not, see <http://www.gnu.org/licenses/>.

module Bindings.Bfd.SymbolTable where

import Control.Monad

import            Data.Char
import qualified  Data.IntMap as IntMap
import            Data.List

import Foreign.Marshal
import Foreign.Ptr

import {-# SOURCE #-} Bindings.Bfd
import                Bindings.Bfd.Disasm.I386.Insn
import                Bindings.Bfd.Misc
import {-# SOURCE #-} Bindings.Bfd.Section as Section
import                Bindings.Bfd.Symbol  as Symbol


data SymbolTable = SymbolTable {
                          tablePtr  :: Ptr Symbol
                        , tableSize :: Int
                   }
     deriving Show


mk
   :: Ptr Symbol
   -> Int
   -> SymbolTable
mk = SymbolTable

toList
   :: SymbolTable
   -> IO [Symbol]
toList st = peekArray (tableSize st) (tablePtr st)

uniqifyNames
   :: SymbolTable
   -> IO SymbolTable
uniqifyNames symt =
   do
      x1 <- toList symt
      x2 <- mapM (\s -> Symbol.getName s) x1
      let
         x3 = zip (x2 \\ nub x2) ([0..] :: [Int])
         x4 = zip x2             ([0..] :: [Int])
         x5 = sort $ intersectBy (\(a,_) (b,_) -> a == b) x4 x3
         x6 = snd $ foldl f (("aa", ""),[]) x5
            where
               f ((post@(ch1:ch0:[]), match), xs) xi 
                  | match == fst xi = ((post', match ), (fst xi ++ "_" ++ post, snd xi) : xs)
                  | otherwise       = (("ab" , fst xi), (fst xi ++ "_aa"      , snd xi) : xs)  
                  where
                     post' =
                        case ch0 == 'z' of
                           True  -> (chr $ ord ch1 + 1) : ['a'              ]
                           False ->  ch1                : [chr $ ord ch0 + 1]
               f _ _ = error "f in uniqifyNames"
      mapM_ (\(name,ix) -> setName (x1 !! ix) name) x6
      return symt

resolveExterns
   :: SymbolTable
   -> Bfd
   -> IO (SymbolTable, Section, IntMap.IntMap Insn)
resolveExterns symTab bfd =
   do
      -- Create the externs section following the last section in the file.

      let
         align = 3
      externsSect <- Section.mk externsName align

      sects <- getSections bfd
      let
         f (v,rs) s =
            do
               v' <- Section.getVma s
               case v' > v of
                  True  -> return (v',s )
                  False -> return (v ,rs)
      (lastSectVma,lastSect) <- foldM f (0,externsSect) sects
      lastSectSize <- Section.getSize lastSect

      let
         externsVma = alignToPower (lastSectVma + lastSectSize) align
      setVma externsSect externsVma

      -- Make a list of the undefined Symbols

      syms <- toList symTab

      let
         isUndef sym =
            do
               sect <- getSection sym
               return $ isUndefined sect
      undefs <- filterM isUndef syms

      -- Set the value of each undefined Symbol to a location in the
      -- externs section

      let
         pointToExtern (vma, cs) sym =
            do
               setValue sym vma
               setSection sym externsSect
               name <- Symbol.getName sym
               return (vma + externSpacing, (vma, Extern name) : cs)

      (_,externs) <- foldM pointToExtern (externsVma,[]) undefs

      return (symTab, externsSect, IntMap.fromList externs)             

externSpacing
   :: Int
externSpacing = 8