-- | Proc.hs
-- A processor circuit.
--
-- Copytight (C) 2007, 2008 Serguey Zefirov
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 3, or (at your option)
-- any later version.
-- See file COPYING or visit http://www.gnu.org/licenses for details.

-- It executes pair programs delivered from matcher circuit.
-- Main role of that circuit is to resolve processor resource
-- allocation conflicts and perform a little scheduling of threads.
--

module Proc where

import InterfaceTypes

import Info

import S

import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Bits

-------------------------------------------------------------------------------
-- Execution devices set configuration.

devSet chaninfos = Map.fromList $ map chan chaninfos++otherDevices
	where
		chan (ch,enabled,width)
			| enabled   = (MessageChannel ch,width)
			| otherwise = (MessageChannel ch,0)
		otherDevices = map (\(r,w) -> (OtherResource r,w)) [
				 (IAdder,6)
				,(ILogic,6)
				,(IMultiplier,1)
				,(FAdder,1)
				,(FMultiplier,1)
				,(FDivider,1)
			]

-------------------------------------------------------------------------------
-- Processor state change function.

processorF execWindow maxProgs shedPolicy
	sendChanWidth
	progTrans
	mask ourindex
	progStates (pair,matcherCTS) =
	(nextProgStates,((tokenMatch,rtr),debInfo))
	where
		-- Can we receive another pair?
		rtr = max 0 (maxProgs - length progStates)
		-- Split programs into working and idle set.
		(workSet,idleSet) = splitAt execWindow progStates
		-- Perform update in work set.
		resourceSet =
			devSet [
					(MsgChannelMatch,matcherCTS,sendChanWidth)
				]
		(workSetDelayed,workSetSheduled,tokenMatch) =
			workCycle [] [] [] workSet resourceSet
		-- expand arguments for progTrans
		expandProgTrans (pair,order) = progTrans pair order
		-- Pair program.
		pairProgram = map expandProgTrans pair
		-- Next program states.
		nextProgStates = case shedPolicy of
			SheduleAllWorkBack ->
				   idleSet
				++ workSetDelayed
				++ workSetSheduled
				++ pairProgram
			SheduleSheduledBack ->
				   workSetDelayed
				++ idleSet
				++ workSetSheduled
				++ pairProgram
			SheduleWindow ->
				   workSetSheduled
				++ workSetDelayed
				++ idleSet
				++ pairProgram
		tripDistMatch = fmap (\msg -> distance mask ourindex (msgModuleAddr msg)) tokenMatch

		isProcMessage (ProcMessage _) = True
		isProcMessage _               = False
		isHeadProcMessage [] = False
		isHeadProcMessage (h:_) = isProcMessage h
		anyProcMessage = or $ map isHeadProcMessage workSet
		anySent = (length tokenMatch) > 0

		procBlocked
			| anyProcMessage && not anySent = "processor is blocked."
			| otherwise = "processor isn't blocked."
		procIdle
			| length progStates < 1 = "processor is idle."
			| otherwise = "processor isn't idle."

		noInfo = ""
		debInfo = "proc info"
			!#	procBlocked
			?#	procIdle
			?#	("matcherCTS",matcherCTS)
--			##	("pair",pair)
--			##	("pairProgram",pairProgram)
--			##	("resourceSet",resourceSet)
--			##	("sendChanWidth",sendChanWidth)
--			##	("progStates",progStates)
--			##	("workSet",workSet)
--			##	("idleSet",idleSet)
--			##	("nextProgStates",nextProgStates)
			##	("tokenMatch",tokenMatch)
--			##	("length tokenMatch",length tokenMatch)
--			##	("mask",mask)
--			##	("ourindex",ourindex)
--			##	("map upPred tokenMatch",map upPred tokenMatch)
--			##	("workSetLen",length workSet)
--			##	("execWindow",execWindow)
--			##	("tripDistMatch",tripDistMatch)
			#!	("procRTR",rtr)

distance mask src dest = case dest of
	HostTok -> ("to host",highest mask)
	ModTok x -> ("to module",2*highest (mask .&. (xor src x)))
	where
		highest 0 = 0
		highest n = 1+highest (shiftR n 1)

hasHeadMsg [] = False
hasHeadMsg (p:ps) = headMsg p || hasHeadMsg ps
headMsg (c:cs) = case c of
	ProcMessage _ -> True
	_             -> False
headMsg _ = False

-- No more programs to update.
workCycle sheduled delayed messageMatch [] _ = (
		 reverse delayed
		,reverse sheduled
		,messageMatch
		)
-- Has at least one program to update.
workCycle sheduled delayed messageMatch (p:ps) resSet
	| notBlocked = workCycle (advanced++sheduled) delayed newMatch ps remainingResources
	| otherwise = workCycle sheduled (p:delayed) messageMatch ps resSet
	where
		(pcommand,advanced) = case p of
			[]     -> (ProcNop,[])
			[c]    -> (c,[])
			(c:cs) -> (c,[cs])
		allocResource r = case Map.lookup r resSet of
			Just 0 -> (False,resSet)
			Just c -> (True,Map.adjust (\x -> x - 1) r resSet)
			Nothing -> error $ unwords ["Can't allocate resource out of the set:",show r,", resources",show resSet]
		(notBlocked,remainingResources) = case pcommand of
			ProcMessage msg -> allocResource $ MessageChannel MsgChannelMatch
			ProcResource r  -> allocResource $ OtherResource r
			ProcNop         -> (True,resSet)
		newMatch = case pcommand of
			ProcMessage msg -> checkMsg messageMatch msg
			_ -> messageMatch
		checkMsg old new = old++[new]

-------------------------------------------------------------------------------
-- Processor circuit

processor execWindow maxProg shedPolicy sendChanWidth progTrans mask ourindex pair matcherCTS =
	(matcherTokens,rtr,info)
	where
		procF = processorF execWindow maxProg shedPolicy sendChanWidth progTrans mask ourindex
		(bus,info) = unzipS $ loopS [] procF $ zipS pair matcherCTS
		(matcherTokens,rtr) = unzipS bus