Digital Hardware Practical HT 2003

The format of this writeup is the edited code with answers to the questions as comments.

:: Question 4: Data type declarations ::

The representation of Datum has been changed from a standard Int to a binary representation - in this case we've defined it to be a 8 bit binary number by setting data_bits to 8, so we have the range (0, 2^8). Two's complement can be easily implemented for the processor, this is shown later in the report. 

all_zeroes is used to create an empty bank of zeroes for the initialisation state of the register and a couple of other things, with data_bits being used as the constant. All assignments of a register to a 0 value now call this function instead. There's also an all_ones.

> type Datum = [ Int ]
> type Data  = [ Datum ]

> type Reg_addr  = Int
> type Reg_addrs = [ Reg_addr ]


> data_bits :: Int
> data_bits = 8

> all_zeroes :: Datum
> all_zeroes = take data_bits (repeat 0)
> all_ones :: Datum
> all_ones = take data_bits (repeat 1)


> n_registers :: Int
> n_registers = 16

> registers :: Reg_addrs -> Data -> Reg_addrs -> Reg_addrs -> (Data,Data)
> registers w_addr w_data a_addr b_addr
>    = (a_data, b_data)
>      where a_data = zipWith reg_read a_addr states
>            b_data = zipWith reg_read b_addr states
>            states = scanl reg_write initial (zip w_addr w_data)
>                     where initial = take n_registers (repeat arbitrary)
>                                     where arbitrary = all_zeroes

That last line is changed, so it uses a bank of zeroes instead of an Int 0.

> adr0, none :: Reg_addr
> adr0 = 0
> none = adr0

> reg_read :: Reg_addr -> [Datum] -> Datum
> reg_read addr regs | addr == adr0 = all_zeroes
>                | otherwise    = head (drop addr regs)

Returns all zeroes if adr0 is asked for.

> reg_write :: [Datum] -> (Reg_addr, Datum) -> [Datum]
> reg_write regs (addr, datum)
>      | addr == none = regs
>      | otherwise    = take addr regs ++ [datum] ++ drop (addr+1) regs

:: Questions 1 and 5 ::

Some new processor instructions. They should be self-explanatory in their functions


> data Fun_code  = NotA | RshaA | LshaA | AddAB | SubAB | OddA | AndA | OrA | XorA
> type Fun_codes = [ Fun_code ]

> type Bit  = Bool
> type Bits = [ Bit ]

> alu :: Fun_codes -> Data -> Data -> Bits -> (Data, Bits)
> alu func a_data b_data sta_control
>     = (result, status)
>       where result  = zipWith alu_fun func (zip a_data b_data)
>             status  = status' False is_zero sta_control
>             is_zero = map null (map (filter (1 ==)) result)
>             status' d (e:is_zero) (True:sta_control)  = e:(status' e is_zero sta_control)
>             status' d (e:is_zero) (False:sta_control) = d:(status' d is_zero sta_control)
 
New status bit used here: it's passed along the data stream, and here it is
changed if the last instruction was important, otherwise the value (d here) is kept.


> alu_fun :: Fun_code -> (Datum, Datum) -> Datum
> alu_fun  NotA (a, b) = notBin a
> alu_fun  OddA (a, b) = tail (all_zeroes ++ [ last a ])

Returns [0,0,...,0,1] if odd, otherwise all zeroes. Does this by just adding the last bit of a to all_zeroes, and removing the first zero so we have the right amount of bits.

> alu_fun RshaA (a, b) = take data_bits (0:a)

Simple, adds a 0 on the front and discards the extra bit at the end of the list.

> alu_fun LshaA (a, b) = tail (a ++ [ 0 ])

Almost identical to Rsha

Note: to implement 2s complement arithmetic, the Rsha and Lsha functions must be changed to this:

 > alu_fun RshaA (a, b) = let (sign : bits) = a
 >                        in   sign : sign : take (data_bits - 2) bit

 > alu_fun LshaA ((sign : a), b) = (a : sign)

These are the subtract and add instruction functions to go with the removed addBin function shown later. As you can see, the aruments are reversed, then addBin called, then the answer reversed back out again. This seems silly, but of course it's easier to do carries with the arguments reversed like this (see the removed addBin for proof of that).However, I made a better add that didn't do this.

 > alu_fun SubAB (a, b) = reverse (addBin (reverse a) (reverse (notBin b)) 1)
 > alu_fun AddAB (a, b) = reverse (addBin (reverse a) (reverse b) 0)

> alu_fun SubAB (a, b) = addBin a (notBin b) 1
> alu_fun AddAB (a, b) = addBin a b 0

Note: a nice bit of extra functionality is that Sub is implemented with one addBin (which recurses, of course) and one notBin. This is because I've given the ability to have a "carry-in", which is what would probably done in most sensible basic processor implementations in hardware.

Since andBin and orBin work with individual bits, we zipWith to do it across the lists of bits:

> alu_fun AndA  (a, b) = zipWith andBin a b
> alu_fun OrA   (a, b) = zipWith orBin a b
> alu_fun XorA  (a, b) = xorBin a b

> andBin :: Int -> Int -> Int
> andBin i j
>   | (i + j) == 2 = 1
>   | otherwise    = 0

Self explanatory. If both are high, adding them gets two, return high, otherwise return low.

> orBin :: Int -> Int -> Int
> orBin i j
>   | (i + j) == 0 = 0
>   | otherwise    = 1

> xorBin :: Datum -> Datum -> Datum
> xorBin [] _ = []
> xorBin (i:is) (j:js)
>   | i == j    = 0:(xorBin is js)
>   | otherwise = 1:(xorBin is js)

xorBin does the whole list instead of individual bits. Just wanted to show a slightly different way of implementing these simple logical instructions.

> notBin :: Datum -> Datum
> notBin a = zipWith (-) all_ones a

This does the same exact thing the original given not function did, but to each bit instead of on an Int.

> addBin :: Datum -> Datum -> Int -> Datum
> addBin is js c = map fst (addBin' is js c)

> addBin' :: Datum -> Datum -> Int -> [(Int,Int)]
> addBin' [i] [j] c 
>   | i+j+c == 3 = [(1,1)]
>   | i+j+c == 2 = [(0,1)]
>   | i+j+c == 1 = [(1,0)]
>   | i+j+c == 0 = [(0,0)]
> addBin' (i:is) (j:js) c
>   | i+j+carry == 3 = (1,1):recurse
>   | i+j+carry == 2 = (0,1):recurse
>   | i+j+carry == 1 = (1,0):recurse
>   | i+j+carry == 0 = (0,0):recurse
>  where recurse = addBin' is js c
>        carry = snd (head (recurse))

In short, this send a double down the list to the LSB, and the snd of the double is the original carry bit. Then do case analysis on each of the four combinations of possible sums of a, b and c.

Complicated, no? That's why it's easier to use the reversing procedure below (however I feel this doesn't fit in with the emulation of a processor. The above would be easily implemented with gates and a latch or two, or just shove a full adder in there).

 > addBin :: Datum -> Datum -> Int -> Datum
 > addBin [] _ _ = []
 > addBin (i:is) (j:js) c 
 >   | i+j+c == 3 = 1:(addBin is js 1)
 >   | i+j+c == 2 = 0:(addBin is js 1)
 >   | i+j+c == 1 = 1:(addBin is js 0)
 >   | i+j+c == 0 = 0:(addBin is js 0)

> mux :: Bits -> Data -> Data -> Data
> mux control left right = zipWith mux_fun control (zip left right)
>                          where mux_fun False (l, r) = l
>                                mux_fun True  (l, r) = r


A few changes: New functions added, and SkipZ and SkipNZ no longer need values to work on, since they check the sta_control, which records if the last interesting instruction returned zero.

> data Instruction = LoadC Int Datum    |
>                    SkipZ              |
>                    SkipNZ             |
>                    Jump  Int          |
>                    Add   Int Int Int  |
>                    Sub   Int Int Int  |
>                    Not   Int Int      |
>                    And   Int Int Int  |
>                    Or    Int Int Int  |
>                    Xor   Int Int Int  |
>                    Rsha  Int Int      |
>                    Lsha  Int Int      |
>                    Odd   Int Int      |
>                    Halt  Int
>      deriving Show

> type Instructions = [ Instruction ]


> type Program = [ Instruction ]

> control :: Program -> Bits -> Instructions
> control rom is_zero
>     = i_register
>       where p_counter  = scanl do_jump 0 (zip i_register is_zero)
>             i_register = map fetch p_counter
>                          where fetch pc = head (drop pc rom)

SkipNZ added here, it's based on SkipZ (a "not b" instead of "b").

> do_jump :: Int -> (Instruction, Bit) -> Int
> do_jump n (Jump m,   b) = m
> do_jump n (SkipZ,  b)   = if b then n+2 else n+1
> do_jump n (SkipNZ,  b)   = if (not b) then n+2 else n+1
> do_jump n (Halt reg, b) = n

This next line needs explaining. By deafult, the processor program doesn't terminate, as you can see by the last line where it jumps from n to n (same instruction repeated ad infinitum). With commented out line here, The processor instead jumps to the next command, although in this implementation there isn't a next command, and so haskell throws an error (cannot do head [] or something). I find this quite convenient. It's commented out, though, since lecturers and such don't seem to like ending programs with errors. Instead, my program ends without doing a Halt at all (literally, runs out of input), but this means you have to search a little back for the calculation result you want to keep.

 > do_jump n (Halt reg, b) = n+1

> do_jump n (i,        b) = n+1


> any_v :: Datum
> any_v  = all_zeroes

Last line was change to reflect binary implementation.

> any_r :: Reg_addr
> any_r = 0

> any_f :: Fun_code
> any_f = AddAB

> decoder :: Instructions ->
>               (Data, Bits, Reg_addrs, Reg_addrs, Reg_addrs, Fun_codes, Bits)

> decoder stream = ([ lit | (lit, _ , _ , _ , _ , _ , _ ) <- word ],
>                   [ mux | ( _ ,mux, _ , _ , _ , _ , _ ) <- word ],
>                   [ wr  | ( _ , _ ,wr , _ , _ , _ , _ ) <- word ],
>                   [ ard | ( _ , _ , _ ,ard, _ , _ , _ ) <- word ],
>                   [ brd | ( _ , _ , _ , _ ,brd, _ , _ ) <- word ],
>                   [ fun | ( _ , _ , _ , _ , _ ,fun, _ ) <- word ],
>                   [ sta | ( _ , _ , _ , _ , _ , _ ,sta) <- word ])

This line is new. We've added a new signal through the decoder to record whether the last instruction was important or not. Note, this is set later in this document, and used right at the top.

>                  where word = map decode_fun stream

> decode_fun :: Instruction ->
>                 (Datum, Bool, Reg_addr, Reg_addr, Reg_addr, Fun_code, Bit)

> decode_fun (LoadC dest val) = (val,   True,  dest, any_r, any_r, any_f, False)
> decode_fun (SkipZ)          = (any_v, False, none, any_r, adr0,  AddAB, False)
> decode_fun (SkipNZ)         = (any_v, False, none, any_r, adr0,  AddAB, False)
> decode_fun (Jump addr)      = (any_v, False, none, any_r, any_r, any_f, False)
> decode_fun (Add dest a b)   = (any_v, False, dest, a,     b,     AddAB, True)
> decode_fun (Sub dest a b)   = (any_v, False, dest, a,     b,     SubAB, True)
> decode_fun (Not dest srce)  = (any_v, False, dest, srce,  any_r, NotA,  True)
> decode_fun (And dest a b)   = (any_v, False, dest, a,     b,     AndA,  True)
> decode_fun (Or dest a b)    = (any_v, False, dest, a,     b,     OrA,   True)
> decode_fun (Xor dest a b)   = (any_v, False, dest, a,     b,     XorA,  True)
> decode_fun (Lsha dest srce) = (any_v, False, dest, srce,  any_r, LshaA, True)
> decode_fun (Rsha dest srce) = (any_v, False, dest, srce,  any_r, RshaA, True)
> decode_fun (Odd dest srce)  = (any_v, False, dest, srce,  any_r, OddA,  True)
> decode_fun (Halt srce)      = (any_v, False, none, srce,  adr0,  AddAB, False)

Lots of new stuff added, but all of them are based on values already there (SkipNZ on SkipZ, Sub, And, etc. on Add), so not much work for me to have done here. The last column contains my value specifying which are important for zero-value-saving. Note jumps, halts and skips are not important.

> run :: Program -> [(Instruction, Datum, Bit)]
> run rom
>    = zip3 stream w_data status

We zip the status bit in here, so use a threeway zip.

>      where (literal, w_select, w_addr, a_addr, b_addr, alu_funcode, sta_control)
>                              = decoder stream

 >            stream            = control rom status

The above line gives the original infinite-running functionality, while the one below cuts it short when it reaches a halt (see defn. of p below). The above one is mor accurate to the emulation,the below one is more convenient.

>            stream            = takeWhile p (control rom status)
>            (result, status) = alu alu_funcode a_data b_data sta_control
>            (a_data, b_data)  = registers w_addr w_data a_addr b_addr
>            w_data            = mux w_select result literal
>            p (Halt _)        = False
>            p _               = True

My multiply program, shown in pseudocode. This is the standard logarithmic multiply program most students learn, to replace the linear one given here originally. Note, right-shifting knocks the last bit of a number off, so the "subtract 1" here turns out to be unnecessary.

Multiply(a, b) {
  var c := 0;
  if (b == 0) then HALT; (* doesn't support second argument as zero *)
  while (a != 0) do
    if IsOdd(a) then {
      a := a - 1; (* done automatically by Rsha *)
      c := c + b;
    }
    a := a / 2;
    b := b * 2;
  }
}

> multiply_program x y
>  = concat code ++ [ Halt c ]
>    where code   = [ init, body, test_even]

>          init      = [ LoadC a x, LoadC b y, LoadC c all_zeroes, 
>                     Add b c b, SkipZ ]
>          body      = [ Odd d a, SkipNZ, Jump l_even,
>                      Add c b c ]
>          test_even = [ Lsha b b, Rsha a a, SkipZ, Jump l_loop ]

>          [start, l_loop, l_even, l_done] = labels
>          labels = scanl (+) 0 (map length code)

>          [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]

Some small programs used to make sure all the other added functionality works.

> add_program x y
>  = [ LoadC a x, LoadC b y, Add a a b, Halt a ]
>    where [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]


> sub_program x y
>  = [ LoadC a x, LoadC b y, Sub a a b, Halt a ]
>    where [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]

> and_program x y
>  = [ LoadC a x, LoadC b y, And a a b, Halt a ]
>    where [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]

> or_program x y
>  = [ LoadC a x, LoadC b y, Or a a b, Halt a ]
>    where [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]

> xor_program x y
>  = [ LoadC a x, LoadC b y, Xor a a b, Halt a ]
>    where [a, b, c, d] = take 4 free_registers
>          free_registers  = [1..]

Want to see a test output? Okay, here's one:



Main> run (multiply_program [0,0,0,1,0,0,1,0] [0,0,0,0,0,1,1,1])

[(LoadC 1 [0,0,0,1,0,0,1,0],[0,0,0,1,0,0,1,0],False),(LoadC 2 [0,0,0,0,0,1,1,1],[0,0,0,0,0,1,1,1],False),(LoadC 3 [0,0,0,0,0,0,0,0],[0,0,0,0,0,0,0,0],False),(Add 2 3 2,[0,0,0,0,0,1,1,1],False),(SkipZ,[0,0,0,0,0,0,0,0],False),(Odd 4 1,[0,0,0,0,0,0,0,0],True),(SkipNZ,[0,0,0,0,0,0,0,0],True),(Jump 9,[0,0,0,0,0,0,0,0],True),(Lsha 2 2,[0,0,0,0,1,1,1,0],False),(Rsha 1 1,[0,0,0,0,1,0,0,1],False),(SkipZ,[0,0,0,0,0,0,0,0],False),(Jump 5,[0,0,0,0,0,0,0,0],False),(Odd 4 1,[0,0,0,0,0,0,0,1],False),(SkipNZ,[0,0,0,0,0,0,0,0],False),(Add 3 2 3,[0,0,0,0,1,1,1,0],False),(Lsha 2 2,[0,0,0,1,1,1,0,0],False),(Rsha 1 1,[0,0,0,0,0,1,0,0],False),(SkipZ,[0,0,0,0,0,0,0,0],False),(Jump 5,[0,0,0,0,0,0,0,0],False),(Odd 4 1,[0,0,0,0,0,0,0,0],True),(SkipNZ,[0,0,0,0,0,0,0,0],True),(Jump 9,[0,0,0,0,0,0,0,0],True),(Lsha 2
2,[0,0,1,1,1,0,0,0],False),(Rsha 1 1,[0,0,0,0,0,0,1,0],False),(SkipZ,[0,0,0,0,0,0,0,0],False),(Jump 5,[0,0,0,0,0,0,0,0],False),(Odd 4 1,[0,0,0,0,0,0,0,0],True),(SkipNZ,[0,0,0,0,0,0,0,0],True),(Jump 9,[0,0,0,0,0,0,0,0],True),(Lsha 2 2,[0,1,1,1,0,0,0,0],False),(Rsha 1 1,[0,0,0,0,0,0,0,1],False),(SkipZ,[0,0,0,0,0,0,0,0],False),(Jump 5,[0,0,0,0,0,0,0,0],False),(Odd 4 1,[0,0,0,0,0,0,0,1],False),(SkipNZ,[0,0,0,0,0,0,0,0],False),(Add 3 2 3,

[0,1,1,1,1,1,1,0]

,False),(Lsha 2 2,[1,1,1,0,0,0,0,0],False),(Rsha 1 1,[0,0,0,0,0,0,0,0],True),(SkipZ,[0,0,0,0,0,0,0,0],True)]

I've added a few carriage returns around the answer. Note if I'd left the Halt in, the answer would be easier to see. This is the price of greater convenience, I guess.

