-- 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            Data.List
import qualified  Data.Map  as Map

import Foreign.Marshal
import Foreign.Ptr

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
   -> [(Section, Vma)]
   -> IO SymbolTable
resolveExterns symt sectList =
   do
      syms <- toList symt
      undefs <- filterM getUndefs syms
      let
         (extSect, extVma) = last sectList
      foldM_ pointToExtern (extSect, extVma) undefs
      map' <- sectMap
      mapM_ (sectSymValue map') syms
      return symt
   where
      sectSymValue map0 sym =
         do
            sect  <- getSection sym
            case isAbsolute sect of
               True  -> return () -- absolute symbols are already absolute
               False ->
                  do
                     name  <- Section.getName sect
                     value <- getValue sym
                     let
                        t =
                           case Map.lookup name map0 of
                              Just v   -> v
                              Nothing  -> error $ "lookup on sect: " ++ show name ++ " " ++ show value ++ "\n" ++ show map0
                     setValue sym $ value + t
      pointToExtern (es,ev) sym =
         do
            setValue sym ev
            setSection sym es
            return (es, ev + externSpacing)             
      getUndefs sym =
         do
            sect <- getSection sym
            return $ isUndefined sect
      sectMap = 
         do
            sectList' <- mapM (\(s,v) -> Section.getName s >>= \n -> return (n,v)) sectList
            return $ Map.fromList sectList'

externSpacing
   :: Int
externSpacing = 8