1 -------------------------------------------------------------------
    2 -- Binary Multiplier  --- Circuit Specification and Simulation
    3 -- John O'Donnell, University of Glasgow. jtod@dcs.glasgow.ac.uk
    4 -- Copyright (c) 1992 by John T. O'Donnell
    5 -- version July 1992
    6 
    7 -------------------------------------------------------------------
    8 {- Introduction
    9 
   10 This program demonstrates some of my work in using functional
   11 programming for digital circuit design.  It works with the hbc
   12 compiler, and if you comment out the definitions of 'Main' and
   13 'main' it also works with gofer.
   14 
   15 The program isn't polished -- I've been experimenting with several
   16 variations, and some of the function definitions are inelegant or
   17 inefficient.
   18 
   19 This source file 'mult.hs' is written in Haskell and contains one
   20 module 'Main'.  The program doesn't read any input; it just prints
   21 a string on stdout.  To run it with hbc:
   22 
   23   (1) set parameters in function 'go'
   24       (wordsize, verbose, limit, xs)
   25   (2) hbc mult.hs   (produces a.out)
   26   (3) a.out         (no input, writes to stdout)
   27 
   28 -}
   29 -------------------------------------------------------------------
   30 {- Parameters
   31 
   32 These parameters defined in "go" control the simulation:
   33 
   34 ** wordsize
   35       How many bits wide the input words to be multiplied are.
   36       The product is 2*wordsize bits wide.
   37 ** limit
   38       The number of clock cycles to run the simulation.
   39 ** verbose
   40       If True, print lots of output.  If False, do the simulation
   41       but print hardly anything.
   42 ** width
   43       Field width in characters for integer output.
   44       (Used only if verbose)
   45 ** xs
   46       A list of pairs of natural numbers to be multiplied.
   47       These should be expressible in 'wordsize' bits, and the
   48       products should be expressible in 2*wordsize bits.
   49 
   50 These parameter values work nicely:
   51     wordsize = 16       -- input size; product is twice this size
   52     limit = 2000        -- how many clock cycles to run
   53     verbose = True      -- want lots of output?
   54     width = 10   -- output Int field size (verbose only)
   55     xs =               -- pairs of integers to be multiplied
   56       [(2+3*i, 11+2*i) | i <- [1..]]
   57 
   58 The verbose output contains one line per clock cycle:
   59     cycle.  start  a    b    ==>   ready   regA   regB   prod
   60 
   61 -}
   62 
   63 -------------------------------------------------------------------
   64 {- The circuit multiplies pairs (a,b) of naturals, producing a*b
   65 
   66 Inputs to the circuit
   67    start :: B
   68    a :: W
   69    b :: W
   70 
   71 Outputs from the circuit
   72    ready :: B
   73    regA  :: W
   74    regB :: W
   75    regP :: W
   76 
   77 Whenever 'start' is 1 the circuit saves its inputs 'a' and 'b' into
   78 its local registers 'regA' and 'regB', and starts multiplying them
   79 using the ordinary shift and add algorithm.  The result is
   80 accumulated in the local register 'regP'.  While the multiplication
   81 is in progress, 'ready' is 0 and the registers show the current
   82 state of the circuit.  When the multiplication is finished, 'regP'
   83 contains the product and 'ready' becomes 1.  The number of cycles
   84 it takes to finish a multiplication depends on the values of the
   85 inputs.
   86 
   87 -}
   88 
   89 -------------------------------------------------------------------
   90 
   91 module Main where
   92 
   93 import System.Environment
   94 
   95 main = do
   96   (n:_) <- getArgs
   97   putStr (go (read n :: Int))
   98 
   99 -------------------------------------------------------------------
  100 -- Definition of the output and the simulation parameters
  101 
  102 go wordsize =
  103   let
  104     limit = 2000        -- how many clock cycles to run
  105     verbose = True      -- want lots of output?
  106     width = 10   -- output Int field size (verbose only)
  107     xs =               -- pairs of integers to be multiplied
  108       [(2+3*i, 11+2*i) | i <- [1..]]
  109   in
  110     "Binary multiplier circuit simulation\n"
  111     ++ (if verbose then traceMult width else runMult)
  112          wordsize limit xs
  113 
  114 -------------------------------------------------------------------
  115 -- Two simulation drivers
  116 
  117 -- 'traceMult' gives full trace information.  Use it to see how
  118 -- the multiplier works.
  119 
  120 traceMult :: Int -> Int -> Int -> [(Int,Int)] -> String
  121 traceMult width wordsize limit xs =
  122   format limit
  123     [fmtInt 5 [0..], fmtStr ". ",
  124      fmtB start, fmtW width as, fmtW width bs, fmtStr "  ==> ",
  125      fmtB ready, fmtW width ra, fmtW width rb, fmtW width prod,
  126      fmtStr "\n"]
  127   where (as,bs,ready,ra,rb,prod) = multsys wordsize xs
  128         start = ready
  129 
  130 -- 'runMult' runs the simulation for "limit" cycles and just prints
  131 -- the number of multiplications that were performed.  Use this
  132 -- to measure simulation time without counting the time required
  133 -- to format the output.  ??? This needs some work -- I'm not sure
  134 -- that all the simulation work is actually performed!
  135 
  136 runMult :: Int -> Int -> [(Int,Int)] -> String
  137 runMult wordsize limit xs = show dummy ++ "\n"
  138   where (as,bs,ready,ra,rb,prod) = multsys wordsize xs
  139         dummy = (sum (take limit ready)) :: Int
  140 
  141 -------------------------------------------------------------------
  142 -- Interface to the multiplier
  143 
  144 -- The multiplier circuit needs an interface that monitors the
  145 -- 'ready' output and sets the inputs.  This interface also handles
  146 -- conversions between integers and words.
  147 
  148 multsys :: Int -> [(Int,Int)] -> (W,W,B,W,W,W)
  149 multsys wordsize xs = (as,bs,ready,ra,rb,prod)
  150   where (ready, ra, rb,  prod) = multiplier wordsize start as bs
  151         start = ready
  152         as  = f (map fst xs)
  153         bs  = f (map snd xs)
  154         f :: [Int] -> W
  155         f as = ntrans wordsize (map (ibits wordsize) (g start as))
  156         g :: B -> [Int] -> [Int]
  157         g [] xs = []
  158         g st [] = []
  159         g (0:sts) xs = 0 : g sts xs
  160         g (1:sts) (x:xs) = x : g sts xs
  161 
  162 -------------------------------------------------------------------
  163 -- The multiplier circuit specification
  164 
  165 multiplier :: Int -> B -> W -> W -> (B,W,W,W)
  166 
  167 multiplier k start a b = (ready, regA, regB, regP)
  168   where
  169     regP = wlat (2*k) (wmux1 (2*k) start sum (rept (2*k) zerO))
  170     (ovfl,sum) = add (2*k) regP (wmux1 (2*k) lsbB
  171                    (rept (2*k) zerO) regA) zerO
  172     regA = wlat (2*k) (wmux1 (2*k) start (shl (2*k) regA)
  173                    (rept k zerO ++ a))
  174     regB = wlat k (wmux1 k start (shr k regB) b)
  175     lsbB = head (drop (k-1) regB)
  176     ready = or2 (regIs0 (2*k) regA) (regIs0 k regB)
  177 
  178 -------------------------------------------------------------------
  179 -- Comparator
  180 
  181 regIs0 :: Int -> W -> B
  182 regIs0 k xs = wideAnd (map inv xs)
  183 
  184 -------------------------------------------------------------------
  185 -- Combinational shifters
  186 
  187 shl :: Int -> W -> W
  188 shl k xs = drop 1 xs ++ [zerO]
  189 
  190 shr :: Int -> W -> W
  191 shr k xs = [zerO] ++ take (k-1) xs
  192 
  193 -------------------------------------------------------------------
  194 -- Adder
  195 
  196 add :: Int -> W -> W -> B -> (B,W)
  197 add 0 xs ys cin = (cin,[])
  198 --should be:add (k+1) (x:xs) (y:ys) cin = (cout,s:ss)
  199 add k (x:xs) (y:ys) cin
  200   | k < 0     = error "Main.add < 0"
  201   | otherwise = (cout,s:ss)
  202   where
  203   (cout,s) = fulladd x y c
  204   (c,ss) = add (k-1) xs ys cin
  205 
  206 halfadd :: B -> B -> (B,B)
  207 halfadd x y = (and2 x y, xor x y)
  208 
  209 fulladd :: B -> B -> B -> (B,B)
  210 fulladd a b c = (or2 w y, z)
  211   where (w,x) = halfadd a b
  212         (y,z) = halfadd x c
  213 
  214 -------------------------------------------------------------------
  215 -- Multiplexors and demultiplexors
  216 
  217 bmux1 :: B -> B -> B -> B
  218 bmux1 c a b = or2 (and2 (inv c) a) (and2 c b)
  219 
  220 wmux1 :: Int -> B -> W -> W -> W
  221 wmux1 k a = word21 k (bmux1 a)
  222 
  223 bdemux1 :: B -> B -> (B,B)
  224 bdemux1 c a = (and2 (inv c) a, and2 c a)
  225 
  226 bdemux :: Int -> [B] -> B -> [B]
  227 bdemux 0 [] x = [x]
  228 --should be:bdemux (n+1) as x = bdemux n (tail as) p ++ bdemux n (tail as) q
  229 bdemux n as x 
  230  | n < 0 = error "bdemux; n < 0"
  231  | otherwise = let n' = n-1 in
  232   bdemux n' (tail as) p ++ bdemux n' (tail as) q
  233   where (p,q) = bdemux1 (head as) x
  234 
  235 -------------------------------------------------------------------
  236 -- Registers
  237 
  238 breg :: B -> B -> B
  239 breg sto a = x
  240   where x = latch (bmux1 sto x a)
  241 
  242 wreg :: Int -> B -> [B] -> [B]
  243 wreg 0 sto [] = []
  244 wreg n sto (x:xs) =
  245   breg sto x : wreg (n-1) sto xs
  246 
  247 wlat :: Int -> [B] -> [B]
  248 wlat 0 xs = []
  249 --should be:wlat (k+1) (x:xs) = latch x : wlat k xs
  250 wlat k (x:xs) | k < 0 = error "wlat"
  251               | otherwise = latch x : wlat (k-1) xs
  252 
  253 -------------------------------------------------------------------
  254 -- Primitive components
  255                                  
  256 latch :: B -> B
  257 latch a = 0:a
  258 
  259 zerO, one :: B
  260 zerO = 0:zerO
  261 one  = 1:one
  262 
  263 inv = lift11 forceBit f
  264   where f :: Bit -> Bit
  265         f 0 = 1
  266         f 1 = 0
  267 
  268 and2 = lift21 forceBit f
  269   where f :: Bit -> Bit -> Bit
  270         f 0 0 = 0
  271         f 0 1 = 0
  272         f 1 0 = 0
  273         f 1 1 = 1
  274 
  275 nand2 = lift21 forceBit f
  276   where f :: Bit -> Bit -> Bit
  277         f 0 0 = 1
  278         f 0 1 = 1
  279         f 1 0 = 1
  280         f 1 1 = 0
  281 
  282 or2 = lift21 forceBit f
  283   where f :: Bit -> Bit -> Bit
  284         f 0 0 = 0
  285         f 0 1 = 1
  286         f 1 0 = 1
  287         f 1 1 = 1
  288 
  289 nor2 = lift21 forceBit f
  290   where f :: Bit -> Bit -> Bit
  291         f 0 0 = 1
  292         f 0 1 = 0
  293         f 1 0 = 0
  294         f 1 1 = 0
  295 
  296 or3 = lift31 forceBit f
  297   where f :: Bit -> Bit -> Bit -> Bit
  298         f 0 0 0 = 0
  299         f 0 0 1 = 1
  300         f 0 1 0 = 1
  301         f 0 1 1 = 1
  302         f 1 0 0 = 1
  303         f 1 0 1 = 1
  304         f 1 1 0 = 1
  305         f 1 1 1 = 1
  306 
  307 xor = lift21 forceBit f
  308   where f :: Bit -> Bit -> Bit
  309         f 0 0 = 0
  310         f 0 1 = 1
  311         f 1 0 = 1
  312         f 1 1 = 0
  313 
  314 -------------------------------------------------------------------
  315 -- Wide gates
  316 
  317 wideGate f [x] = x
  318 wideGate f xs =
  319   f (wideGate f (take i xs))
  320     (wideGate f (drop i xs))
  321   where i = length xs `div` 2
  322 
  323 wideAnd xs  = wideGate and2 xs
  324 wideNand xs = wideGate nand2 xs
  325 wideOr xs   = wideGate or2 xs
  326 wideNor xs  = wideGate nor2 xs
  327 
  328 -------------------------------------------------------------------
  329 -- Auxiliary definitions
  330 
  331 type Bit = Int
  332 type B = [Bit]
  333 type W = [B]
  334 
  335 forceBit :: Bit->Bool
  336 forceBit x = (x==0)
  337 
  338 headstrict :: (a->Bool) -> [a] -> [a]
  339 headstrict force [] = []
  340 headstrict force xs = if force (head xs) then xs else xs
  341 
  342 pairstrict :: (a->Bool) -> (b->Bool) -> ([a],[b]) -> ([a],[b])
  343 pairstrict force1 force2 p =
  344   if force1 (head x)
  345      then if force2 (head y) then p else p
  346      else if force2 (head y) then p else p
  347   where (x,y) = p
  348 
  349 lift11 force f [] = []
  350 lift11 force f (x:xs) = headstrict force (f x : lift11 force f xs)
  351 
  352 {-
  353 lift21 force f [] zs = []
  354 lift21 force f ys [] = []
  355 lift21 force f (y:ys) (z:zs) =
  356   headstrict force (f y z : lift21 force f ys zs)
  357 -}
  358 
  359 --lift21 force f [] zs = []
  360 --lift21 force f ys [] = []
  361 lift21 force f (y:ys) (z:zs) =
  362    (f y z : lift21 force f ys zs) -- ??? space leak here?
  363 
  364 lift31 force f [] ys zs = []
  365 lift31 force f xs [] zs = []
  366 lift31 force f xs ys [] = []
  367 lift31 force f (x:xs) (y:ys) (z:zs) =
  368   headstrict force (f x y z : lift31 force f xs ys zs)
  369 
  370 lift41 force f [] xs ys zs = []
  371 lift41 force f ws [] ys zs = []
  372 lift41 force f ws xs [] zs = []
  373 lift41 force f ws xs ys [] = []
  374 lift41 force f (w:ws) (x:xs) (y:ys) (z:zs) =
  375   headstrict force (f w x y z : lift41 force f ws xs ys zs)
  376 
  377 lift22 force1 force2 f [] ys = ([],[])
  378 lift22 force1 force2 f xs [] = ([],[])
  379 lift22 force1 force2 f (x:xs) (y:ys) =
  380   pairstrict force1 force2 (a:as, b:bs)
  381   where (a,b) = f x y
  382         (as,bs) = lift22 force1 force2 f xs ys
  383 
  384 -------------------------------------------------------------------
  385 -- Words
  386 
  387 word11 :: Int -> (a->b) -> [a] -> [b]
  388 word11 0 f as = []
  389 word11 k f as = f (head as) : word11 (k-1) f (tail as)
  390 
  391 word21 :: Int -> (a->b->c) -> [a] -> [b] -> [c]
  392 word21 0 f as bs = []
  393 word21 k f as bs =
  394   f (head as) (head bs) : word21 (k-1) f (tail as) (tail bs)
  395 
  396 word31 :: Int -> (a->b->c->d) -> [a] -> [b] -> [c] -> [d]
  397 word31 0 f as bs cs = []
  398 word31 k f as bs cs =
  399   f (head as) (head bs) (head cs) :
  400     word31 (k-1) f (tail as) (tail bs) (tail cs)
  401 
  402 word12 :: Int -> (a->(b,c)) -> [a] -> ([b],[c])
  403 word12 0 f as = ([],[])
  404 word12 k f as = (b:bs,c:cs)
  405   where (b,c) = f (head as)
  406         (bs,cs) = word12 (k-1) f (tail as)
  407 
  408 word22 :: Int -> (a->b->(c,d)) -> [a] -> [b] -> ([c],[d])
  409 word22 0 f as bs = ([],[])
  410 word22 k f as bs = (c:cs,d:ds)
  411   where (c,d) = f (head as) (head bs)
  412         (cs,ds) = word22 (k-1) f (tail as) (tail bs)
  413 
  414 -------------------------------------------------------------------
  415 -- Conversions
  416 
  417 shoInt :: Int -> String
  418 shoInt n = show n
  419 
  420 trans :: [[a]] -> [[a]]
  421 trans xs =
  422   if or (map null xs)
  423     then []
  424     else map head xs : trans (map tail xs)
  425 
  426 ntrans 0 xs = []
  427 ntrans i xs = map head xs : ntrans (i-1) (map tail xs)
  428 
  429 dec :: Int -> Int -> String
  430 dec k n =
  431   if i<k then (rept (k-i) ' ') ++ xs else xs
  432   where xs = show n
  433         i = length xs
  434 
  435 ibits :: Int -> Int -> [Int]
  436 ibits n i = reverse (f_ibits n i)
  437   where f_ibits 0 i = []
  438         f_ibits n i = i `mod` 2 : f_ibits (n-1) (i `div` 2)
  439 
  440 {- bitsi converts a binary number represented by a list of bits
  441 into an integer. -}
  442 
  443 bitsi :: [Int] -> Int
  444 bitsi = f_bitsi 0
  445   where f_bitsi i [] = i
  446         f_bitsi i (b:bs) = f_bitsi (2*i+b) bs
  447 
  448 -- These functions lift the integer--bits conversions to streams.
  449 
  450 intrep :: [B] -> [Int]
  451 intrep bs = map bitsi (trans bs)
  452 
  453 bitrep :: Int -> [Int] -> [B]
  454 bitrep n = ntrans n . map (ibits n)
  455 
  456 -------------------------------------------------------------------
  457 -- Formatting
  458 
  459 rept :: Int -> a -> [a]
  460 rept 0 x = []
  461 rept i x = x : rept (i-1) x
  462 
  463 mksepline c = "\n" ++ rept 79 c ++ "\n"
  464 sepline = mksepline '-'
  465 bigsepline = mksepline '='
  466    
  467 format :: Int -> [[[a]]] -> [a]
  468 format limit = concat . take limit . map concat . trans
  469 
  470 --fmtW :: Int -> W ->
  471 fmtW i xs = fmtDec i (intrep xs)
  472 
  473 -- fmtDec  width of field
  474 fmtDec :: Int -> [Int] -> [String]
  475 fmtDec w = map (dec w)
  476 
  477 fmtB :: B -> [String]
  478 fmtB = map (dec 1)
  479 
  480 fmtInt :: Int -> [Int] -> [String]
  481 fmtInt i = map (dec i)
  482 
  483 fmtFld :: (Int->Bit->String) -> Int -> [B] -> [String]
  484 fmtFld f i xs = map (f i) (intrep xs)
  485 
  486 fmtList :: (a->String) -> [[a]] -> [String]
  487 fmtList f xs = map (g . concat . map f) xs
  488   where g cs = cs ++ "  "
  489 
  490 fmtStr :: String -> [String]
  491 fmtStr s = s : fmtStr s
  492 
  493 {- when takes a ready signal xs and an arbitrary signal ys,
  494 returning the value on the ys signal at the first cycle that xs is
  495 1. -}
  496 
  497 when :: B -> W -> [Int]
  498 when (0:xs) w = when xs (map tail w)
  499 when (1:xs) w = map head w
  500 
  501 -------------------------------------------------------------------