manycore.expc

haskell {

(>>>) :: Bits a => a -> Int -> a
(>>>) = shiftR

(<<<) :: Bits a => a -> Int -> a
(<<<) = shiftL

type Int8 = Unsigned 8
type PC = Unsigned 5

type InstructionWord = Unsigned 8

type RegID = Unsigned 2
type Immediate = Unsigned 5

data Instruction
    = ReadFIFO RegID
    | WriteFIFO RegID
    | Add RegID RegID RegID
    | Move RegID RegID
    | Branch RegID RegID
    | LoadImm RegID Immediate
    deriving (Show, Generic, NFDataX, BitPack)

nop = Move 0 0

data FIFOCommand
    = FIFO_Write Int8
    | FIFO_Read
    | FIFO_Nothing
    deriving (Show, Generic, NFDataX, BitPack)

type ReadRegs = (RegID, RegID)
type WriteReg = Maybe (Int8, RegID)
type RegisterFile = Vec 3 Int8

decode :: InstructionWord -> Instruction
decode word = if (bit 7)
    then LoadImm immreg imm
    else if not (bit 6)
        then Add reg45 reg23 reg01
        else if (bit 5)
            then if bit 4
                then WriteFIFO reg23
                else ReadFIFO reg23
            else if bit 4
                then Branch reg23 reg01
                else Move reg23 reg01
    where
        bit = testBit word
        -- the .&. is probably unnecessary due to the resize
        imm = resize $ word .&. 0b11111
        immreg = resize $ (word >>> 5) .&. 0b11
        reg01 = resize $ word .&. 0b11
        reg23 = resize $ (word >>> 2) .&. 0b11
        reg45 = resize $ (word >>> 4) .&. 0b11

encode :: Instruction -> InstructionWord
encode instr = case instr of
    ReadFIFO id ->
        0b0110_0000 .|. (resize id <<< 2)
    WriteFIFO id -> 
        0b0111_0000 .|. (resize id <<< 2)
    Add left right dest -> 
        0b0000_0000 .|. (resize left <<< 4) .|. (resize right <<< 2) .|. (resize dest)
    Move from to -> 
        0b0100_0000 .|. (resize from <<< 2) .|. (resize to)
    Branch cond addr -> 
        0b0101_0000 .|. (resize cond <<< 2) .|. (resize addr)
    LoadImm reg imm -> 
        0b1000_0000 .|. (resize reg <<< 5) .|. (resize imm)

empty_regs :: RegisterFile
empty_regs = 0:>0:>0:>Nil

type Program = Vec 32 InstructionWord

test_router_inp :: [(Bool, FIFOCommand)]
test_router_inp = [
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 13),
        (True, FIFO_Write 21),
        (True, FIFO_Nothing),
        (True, FIFO_Write 7),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 59),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 3),
        (True, FIFO_Write 3),
        (True, FIFO_Write 3),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 19),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 17),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 1),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Write 0),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing),
        (True, FIFO_Nothing)
    ] L.++ (L.take 30 $ L.repeat (True, FIFO_Nothing))

default_prog :: Program
default_prog = map encode $ program ++ repeat (nop)
    where
        program = 
            (LoadImm 1 1):>     -- 0 Load non-zero value in reg1 to avoid jumping
            (LoadImm 3 7):>     -- 1 Set jump addr to write sequence
            (ReadFIFO 1):>      -- 2 read from fifo
            (Branch 1 3):>      -- 3 if we receive zero, jump to write sequence
            (Add 1 2 2):>       -- 4 otherwise, add input to sum reg
            (LoadImm 3 1):>     -- 5 Set jump addr to start of program
            (Branch 0 3):>      -- 6 Always jump to address 1, i.e. read again
            
            (LoadImm 3 31):>    -- 7 Set destination to (4, 5)
            (LoadImm 1 31):>    -- 8 We need this convoluted way, since (4, 5) is 69
            (Add 1 3 3):>       -- 9 as an encoded value, which does not fit in 5 bits imm_values...
            (LoadImm 1 7):>     -- 10 31 + 31 + 7 = 69, probably better to use the 5th loadimm bit for
            (Add 1 3 3):>       -- 11 load upper vs load lower, but meh
            (WriteFIFO 3):>     -- 12 write destination
            (WriteFIFO 2):>     -- 13 write sum value
            (LoadImm 3 15):>    -- 14 set jump addr to end program
            (Branch 0 3):>      -- 15 End program, infinite loop
            Nil


writes :: FIFOCommand -> Maybe Int8
writes (FIFO_Write a) = Just a
writes _ = Nothing

type DataQueue = Vec 8 Int8
type DataPtr = Unsigned 3

empty_queue :: DataQueue
empty_queue = 1:>2:>3:>4:>5:>6:>7:>8:>Nil

type PacketQueue = Vec 4 Packet
data Packet = Packet Location Int8
    deriving (Show, Generic, NFDataX, BitPack)
type Location = (Unsigned 4, Unsigned 4)

empty_packet_queue :: PacketQueue
empty_packet_queue = zr:>zr:>zr:>zr:>Nil
    where
        zr = Packet (0, 0) 0

empty_packet :: Packet
empty_packet = Packet (0, 0) 0

empty_loc :: Location
empty_loc = (0, 0)

nothing = Nothing

data PacketControlState = Idle | GotLoc Location | Ready Location Int8
    deriving (Show, Generic, NFDataX, BitPack)

int2loc :: Int8 -> Location
int2loc v = (resize $ v >>> 4, resize v)

loc2int :: Location -> Int8
loc2int (x, y) = resize x <<< 4 .|. resize y

data SerializerState = SerIdle | SerSendLoc Packet | SerSendVal Packet
    deriving (Show, Generic, NFDataX, BitPack)

data Direction = North | East | South | West | Core
    deriving (Show, Generic, NFDataX, BitPack, Eq)

router_test_data :: [(Maybe Packet, Maybe Int8, Maybe Int8, Maybe Int8, Maybe Int8)]
router_test_data = [
        (Nothing, Just 17, Nothing, Nothing, Nothing),
        (Nothing, Just 80, Nothing, Nothing, Nothing),
        (Nothing, Nothing, Nothing, Just 0b1_0010, Nothing),
        (Nothing, Nothing, Nothing, Just 79, Nothing),
        (Nothing, Just 0b0001_0000, Just 0b0010_0001, Nothing, Nothing),
        (Nothing, Just 13, Just 14, Nothing, Nothing),
        (Nothing, Just 0b0010_0001, Nothing, Just 18, Nothing),
        (Nothing, Just 55, Nothing, Just 78, Nothing),
        (Nothing, Nothing, Nothing, Nothing, Nothing),
        (Nothing, Nothing, Nothing, Nothing, Nothing),
        (Nothing, Nothing, Nothing, Nothing, Nothing),
        (Nothing, Nothing, Nothing, Nothing, Nothing),
        (Nothing, Nothing, Nothing, Nothing, Nothing)
    ]

to_br_data :: [(Maybe Int8, Maybe Int8)]
to_br_data = [
        (Just 0b000_0001, Just 0b0011_0001),
        (Just 59, Just 13),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing),
        (Nothing, Nothing)
    ]

mc_input :: [Maybe Int8]
mc_input = [
        Just 17, Just 5, 
        Nothing, Nothing, 
        Just 18, Just 13,
        Nothing, Nothing,
        Nothing, Nothing,
        Nothing, Nothing,
        Just 17, Just 5, 
        Just 18, Just 13,
        Nothing, Nothing,
        Just 17, Just 0,
        Just 18, Just 0
    ] L.++ (L.take 1000 $ L.repeat Nothing)

}

component datapath() {
    input instr_word : InstructionWord
    input reg_a : Int8
    input reg_b : Int8
    input fifo_val : Maybe Int8

    state delay = 0 : InstructionWord
    state pc = 0 : PC

    output read_ids : ReadRegs
    output update_regs : WriteReg

    output fifo_cmd : FIFOCommand
    output pc_out : PC
    -- 5x4

    instruction = decode instr_word
    delay' = instr_word

    read_ids = case instruction of
        (ReadFIFO _) -> (0, 0)
        (WriteFIFO reg) -> (0, reg)
        (Add left right _) -> (left, right)
        (Move from _) -> (from, 0)
        (Branch cond addr) -> (cond, addr)
        (LoadImm _ _) -> (0, 0)

    delayed_instr = decode delay

    update_regs = case instruction of
        (ReadFIFO dest) -> case fifo_val of
            Just v -> Just (v, dest)
            Nothing -> Nothing
        (WriteFIFO _) -> Nothing
        (Add _ _ dest) -> Just (reg_a + reg_b, dest)
        (Move _ to) -> Just (reg_a, to)
        (Branch _ _) -> Nothing
        (LoadImm reg imm) -> Just (resize imm, reg)

    update_pc = case instruction of
        (Branch _ _) -> if reg_a == 0
            then Just $ resize reg_b
            else Nothing
        (ReadFIFO _) -> case fifo_val of
            Nothing -> Just pc


    fifo_cmd = case instruction of
        (ReadFIFO _) -> FIFO_Read
        (WriteFIFO _) -> FIFO_Write reg_b
        _ -> FIFO_Nothing


    pc' = case instruction of
        (Branch _ _) -> if reg_a == 0
            then resize reg_b
            else pc + 1
        (ReadFIFO _) -> case fifo_val of
            Nothing -> pc -- block on no value
            _ -> pc + 1
        _ -> pc + 1

    pc_out = pc

}

component registers() {
    input read_ids : ReadRegs
    input write : WriteReg

    state regs = empty_regs : RegisterFile

    output reg_a : Int8
    output reg_b : Int8

    -- 4x4

    regs' =
        case write of
            Just (value, regid) -> if regid == 0
                then regs
                else replace (regid - 1) value regs
            Nothing -> regs

    (reg_a_id, reg_b_id) = read_ids

    reg_a = if reg_a_id == 0
        then 0
        else regs !! (reg_a_id - 1)
    reg_b = if reg_b_id == 0
        then 0
        else regs !! (reg_b_id - 1)
}

component prog_mem() {
    input pc : PC
    state program = default_prog : Program
    output instr : InstructionWord
    -- voor default prog, moeilijk weinig: like 3x3, maar wsch in general een stuk meer nodig

    instr = program !! pc
    program' = program
}

component queue_controller() {
    input proc_cmd : FIFOCommand
    input route_cmd : FIFOCommand
    input router_read : Bool
    
    input outgoing_empty : Bool
    input outgoing_value : Packet
    output outgoing_read : Bool
    output read_packet : Maybe Packet

    input incoming_value : Int8
    input incoming_empty : Bool
    output incoming_read : Bool
    output incoming_write : Bool
    output incoming_datain : Int8
    output read_value : Maybe Int8

    -- 11 LUTs, ze lagen wat verspreid, niet veel iig.

    incoming_read = case proc_cmd of
        FIFO_Read -> True && (not incoming_empty)
        _ -> False
    
    incoming_write = case route_cmd of
        FIFO_Write _ -> True
        _ -> False

    incoming_datain = case route_cmd of
        FIFO_Write v -> v
        _ -> 0

    outgoing_read = router_read && (not outgoing_empty)

    read_value = if incoming_read
        then Just incoming_value
        else Nothing

    read_packet = if outgoing_read
        then Just outgoing_value
        else Nothing
}



component in_fifo() {
    input datain : Int8
    input write : Bool
    input read : Bool
    state rpntr = 0 : Unsigned 4
    state wpntr = 0 : Unsigned 4
    state elms = empty_queue : DataQueue
    output dataout : Int8
    output empty : Bool
    -- output full : Bool
    -- 6x5, at least

    -- https://github.com/clash-lang/clash-compiler/blob/master/examples/Fifo.hs
    wpntr' | write     = wpntr + 1
           | otherwise = wpntr
    rpntr' | read      = rpntr + 1
           | otherwise = rpntr

    mask  = resize (maxBound :: Unsigned 3)
    wind  = wpntr .&. mask
    rind  = rpntr .&. mask

    elms' | write     = replace wind datain elms
          | otherwise = elms

    n = 3

    empty = wpntr == rpntr
    full  = (testBit wpntr n) /= (testBit rpntr n) &&
            (wind == rind)

    dataout = elms !! rind

}

component packet_queue() {
    input datain : Maybe Packet
    input read : Bool
    state rpntr = 0 : Unsigned 3
    state wpntr = 0 : Unsigned 3
    state elms = empty_packet_queue : PacketQueue
    output dataout : Packet
    output empty : Bool
    -- output full : Bool
    -- 5x5

    write = case datain of
        Just _ -> True
        Nothing -> False

    -- https://github.com/clash-lang/clash-compiler/blob/master/examples/Fifo.hs
    wpntr' | write     = wpntr + 1
           | otherwise = wpntr
    rpntr' | read      = rpntr + 1
           | otherwise = rpntr

    mask  = resize (maxBound :: Unsigned 2)
    wind  = wpntr .&. mask
    rind  = rpntr .&. mask

    elms' | write     = case datain of
                            (Just v) -> replace wind v elms
          | otherwise = elms

    n = 3

    empty = wpntr == rpntr
    full  = (testBit wpntr n) /= (testBit rpntr n) &&
            (wind == rind)

    dataout = elms !! rind
}

component packet_control() {
    input proc_cmd : FIFOCommand
    state ctrl_state = Idle : PacketControlState
    output packet : Maybe Packet
    -- 3x3 is ruim

    ctrl_state' = case ctrl_state of
        Idle -> case proc_cmd of
            (FIFO_Write v) -> GotLoc (int2loc v)
            _ -> Idle
        GotLoc l -> case proc_cmd of
            (FIFO_Write v) -> Ready l v
            _ -> GotLoc l
        Ready _ _ -> Idle
    
    write = case ctrl_state of
        Ready _ _ -> True
        _ -> False
    
    packet = case ctrl_state of
        Ready l v -> Just $ Packet l v
        _ -> Nothing

}



component pkt_ser() {
    input empty_send_queue       : Bool
    input packet                 : Packet

    state ser_state = SerIdle    : SerializerState
    state send_loc = True        : Bool

    output value                 : Maybe Int8
    output read_from_send_queue  : Bool

    send_loc' = not send_loc

    ser_state' = case ser_state of
        SerIdle -> if read_from_send_queue
            then SerSendLoc packet
            else SerIdle
        SerSendLoc p -> SerSendVal p
        SerSendVal p -> if read_from_send_queue
            then SerSendLoc packet
            else SerIdle

    value = case ser_state' of
        SerIdle -> Nothing
        SerSendLoc (Packet loc _) -> Just $ loc2int loc
        SerSendVal (Packet _ val) -> Just val

    read_from_send_queue = send_loc && not empty_send_queue
}

component pkt_des() {
    input value : Maybe Int8
    state recv_loc = True : Bool
    state prev_value = Nothing : Maybe Int8
    output packet : Maybe Packet

    recv_loc' = not recv_loc
    prev_value' = value

    packet = if recv_loc
        then Nothing
        else case value of
            -- if this fromjust triggers, input data is out of sync with the des
            (Just value) -> case prev_value of
                (Just loc) -> Just $ Packet (int2loc loc) (value) 
            Nothing -> Nothing

}

component direction_decider() {
    input my_x       : Unsigned 4
    input my_y       : Unsigned 4
    input from_north : Maybe Packet
    input from_east  : Maybe Packet
    input from_south : Maybe Packet
    input from_west  : Maybe Packet
    input from_core  : Maybe Packet

    state read_timer = 0 : Unsigned 2

    output to_north  : Maybe Packet
    output to_east   : Maybe Packet
    output to_south  : Maybe Packet
    output to_west   : Maybe Packet
    output to_proc   : FIFOCommand
    output ready     : Bool

    -- expects to be have my_x and my_y driven by a constant signal.

    to_north = pick_packet North
    to_east = pick_packet East
    to_south = pick_packet South
    to_west = pick_packet West
    to_proc = to_fifo $ pick_packet Core
    ready = read_timer == 0

    read_timer' = read_timer + 1

    dest (Just (Packet (x, y) _))
        | x > my_x = Just East
        | x < my_x = Just West
        | y > my_y = Just South
        | y < my_y = Just North
        | x == my_x && y == my_y = Just Core
    dest Nothing = Nothing

    -- silently drops packets :(
    pick_packet dir = if dest from_core == Just dir
        then from_core
        else if dest from_north == Just dir
            then from_north
            else if dest from_east == Just dir
                then from_east
                else if dest from_south == Just dir
                    then from_south
                    else if dest from_west == Just dir
                        then from_west
                        else Nothing

    to_fifo pkt = case pkt of
        Just (Packet _ v) -> FIFO_Write v
        Nothing -> FIFO_Nothing
}

component cap() {
    input out    : Maybe Int8
    output inp : Maybe Int8

    inp = Nothing
}