Another reorg.

8 files changed, 104 insertions, 223 deletions

diff --git a/clean.sh b/clean.sh
index d37cd91..c8a4e4d 100755
--- a/clean.sh
+++ b/clean.sh
@@ -1,5 +1,6 @@
 #!/usr/bin/env bash
 set -euxo pipefail
+cd "$(dirname "${BASH_SOURCE[0]}")"
 git status --porcelain=v1 --ignored -z \
 | grep -z '^!!' \
 | xargs -0 awk 'BEGIN { for(i = 1; i < ARGC; i++) printf "%s%c", substr(ARGV[i], 4), 0; }' \
diff --git a/fpga/Makefile b/fpga/Makefile
index c9326a7..edbb7d1 100644
--- a/fpga/Makefile
+++ b/fpga/Makefile
@@ -1,41 +1,32 @@
 BSC_COMP_FLAGS = -bdir tmp -p src:+ -simdir tmp -vdir tmp
 BSC_LINK_FLAGS = -bdir tmp -simdir tmp -vdir tmp
 BSC_SOURCES = BRAM2.v FIFO1.v FIFO10.v RevertReg.v SizedFIFO.v
-TOPFILE = Top
-TOPMODULE = mkTop
-SRCS = $(shell find src -name '*.bs')
 
-all: tmp/$(TOPMODULE).bin
-flash: tmp/$(TOPMODULE).bin
+all: tmp/mkTop.bin
+flash: tmp/mkTop.bin
 	sudo iceprog $<
 gtkwave: tmp/sim.vcd
 	gtkwave -A $<
 .PHONY: all flash gtkwave
 
-tmp/sim.vcd: tmp/$(TOPMODULE)Sim.exe
-	tmp/$(TOPMODULE)Sim.exe -V $@
 tmp/%.bin: tmp/%.asc
-	# https://github.com/YosysHQ/icestorm/issues/114
-	# icetime -d up5k -c 12 $<
 	icepack $< $@
 tmp/%.asc tmp/%-report.json: tmp/%.json src/icebreaker.pcf
 	nextpnr-ice40 -ql tmp/$*.nplog --up5k --package sg48 --freq 12 \
 		--asc $@ --report tmp/$*-report.json \
 		--pcf src/icebreaker.pcf --json $<
-tmp/$(TOPMODULE).json: tmp/$(TOPMODULE).v $(addprefix $(BSC)/lib/Verilog/,$(BSC_SOURCES))
-	yosys -ql tmp/$(TOPMODULE).yslog -p 'synth_ice40 -top mkTop -json $@' $^
-tmp/$(TOPMODULE)Sim.exe: tmp/$(TOPFILE).bo
-	bsc -u -sim -g $(TOPMODULE)Sim $(BSC_COMP_FLAGS) src/$(TOPFILE)Sim.bs
-	bsc -sim -e $(TOPMODULE)Sim $(BSC_LINK_FLAGS) -o $@
-tmp/$(TOPMODULE).v: tmp/$(TOPFILE).bo
-	bsc -g $(TOPMODULE) -verilog $(BSC_COMP_FLAGS) src/$(TOPFILE).bs
-tmp/%.bo:
+tmp/mkTop.json: tmp/mkTop.v $(addprefix $(BSC)/lib/Verilog/,$(BSC_SOURCES))
+	yosys -ql tmp/mkTop.yslog -p 'synth_ice40 -top mkTop -json $@' $^
+tmp/mkTop.v:
 	@mkdir -p $(dir $@)
-	bsc -verilog $(BSC_COMP_FLAGS) $<
-# Hack around not having precise dependency information for Bluespec files.
-.PHONY: tmp/$(TOPFILE).bo
+	bsc -u -verilog -g mkTop $(BSC_COMP_FLAGS) src/Top.bs
 
-tmp/depends.mk:
+tmp/sim.vcd: tmp/mkTopSim.exe
+	tmp/mkTopSim.exe -V $@
+tmp/mkTopSim.exe: tmp/mkTopSim.ba
+	bsc -sim -e mkTopSim $(BSC_LINK_FLAGS) -o $@
+tmp/mkTopSim.ba:
 	@mkdir -p $(dir $@)
-	bluetcl -exec makedepend $(BSC_COMP_FLAGS) src/$(TOPFILE).bs > $@
-include tmp/depends.mk
+	bsc -u -sim -g mkTopSim $(BSC_COMP_FLAGS) src/Top.bs
+
+.PHONY: tmp/mkTop.v tmp/mkTopSim.ba
diff --git a/fpga/src/App.bs b/fpga/src/App.bs
deleted file mode 100644
index cbe6454..0000000
--- a/fpga/src/App.bs
+++ /dev/null
@@ -1,154 +0,0 @@
-package App where
-
-import BRAM
-import GetPut
-
-interface App =
-  led :: Bit 1
-
-hexToBits :: Bit 8 -> Maybe (Bit 4)
-hexToBits 0x30 = Just 0b0000
-hexToBits 0x31 = Just 0b0001
-hexToBits 0x32 = Just 0b0010
-hexToBits 0x33 = Just 0b0011
-hexToBits 0x34 = Just 0b0100
-hexToBits 0x35 = Just 0b0101
-hexToBits 0x36 = Just 0b0110
-hexToBits 0x37 = Just 0b0111
-hexToBits 0x38 = Just 0b1000
-hexToBits 0x39 = Just 0b1001
-hexToBits 0x41 = Just 0b1010
-hexToBits 0x42 = Just 0b1011
-hexToBits 0x43 = Just 0b1100
-hexToBits 0x44 = Just 0b1101
-hexToBits 0x45 = Just 0b1110
-hexToBits 0x46 = Just 0b1111
-hexToBits 0x61 = Just 0b1010
-hexToBits 0x62 = Just 0b1011
-hexToBits 0x63 = Just 0b1100
-hexToBits 0x64 = Just 0b1101
-hexToBits 0x65 = Just 0b1110
-hexToBits 0x66 = Just 0b1111
-hexToBits _ = Nothing
-
-bitsToHex :: Bit 4 -> Bit 8
-bitsToHex b =
-  if b < 10
-  then 0x30 + (0 ++ b)
-  else 0x41 + (0 ++ (b - 10))
-
-data State
-  = WaitingForAddrHiNybble
-  | WaitingForAddrLoNybble (Bit 4)
-  | WaitingForRW (Bit 8)
-  | WaitingForRead
-  | WritingData3 (Bit 12)
-  | WritingData2 (Bit 8)
-  | WritingData1 (Bit 4)
-  | WritingCR
-  | WritingLF
-  | WaitingForValueNybble1 (Bit 8)
-  | WaitingForValueNybble2 (Bit 8) (Bit 4)
-  | WaitingForValueNybble3 (Bit 8) (Bit 8)
-  | WaitingForValueNybble4 (Bit 8) (Bit 12)
-  deriving (Bits)
-
-mkApp :: Get (Bit 8) -> Put (Bit 8) -> Module App
-mkApp uartRecv uartSend =
-  module
-    led :: Reg (Bit 1) <- mkReg 1
-    state :: Reg State <- mkReg WaitingForAddrHiNybble
-    ebr :: BRAM2Port (Bit 8) (Bit 16) <- mkBRAM2Server
-      (defaultValue { memorySize = 256 })
-
-    rules
-      "get_hi_nybble": when WaitingForAddrHiNybble <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just hiNybble -> do
-            uartSend.put byte
-            state := WaitingForAddrLoNybble hiNybble
-          Nothing -> return ()
-      "get_lo_nybble": when WaitingForAddrLoNybble hiNybble <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just loNybble -> do
-            uartSend.put byte
-            state := WaitingForRW (hiNybble ++ loNybble)
-            led := 0
-          Nothing -> return ()
-      "get_rw": when WaitingForRW addr <- state ==> do
-        byte <- uartRecv.get
-        case byte of
-          0x72 {- r -} -> do
-            uartSend.put byte
-            ebr.portA.request.put (BRAMRequest
-              { write = False
-              ; responseOnWrite = _
-              ; address = addr
-              ; datain = _
-              })
-            state := WaitingForRead
-          0x77 {- w -} -> do
-            uartSend.put byte
-            state := WaitingForValueNybble1 addr
-          _ -> return ()
-      "get_read": when WaitingForRead <- state ==> do
-        resp <- ebr.portA.response.get
-        uartSend.put (bitsToHex resp[15:12])
-        state := WritingData3 resp[11:0]
-      "write_data_3": when WritingData3 resp <- state ==> do
-        uartSend.put (bitsToHex resp[11:8])
-        state := WritingData2 resp[7:0]
-      "write_data_2": when WritingData2 resp <- state ==> do
-        uartSend.put (bitsToHex resp[7:4])
-        state := WritingData1 resp[3:0]
-      "write_data_1": when WritingData1 resp <- state ==> do
-        uartSend.put (bitsToHex resp)
-        state := WritingCR
-      "write_cr": when WritingCR <- state ==> do
-        uartSend.put 0x0d
-        state := WritingLF
-      "write_lf": when WritingLF <- state ==> do
-        uartSend.put 0x0a
-        state := WaitingForAddrHiNybble
-        led := 1
-      "get_nybble_1": when WaitingForValueNybble1 addr <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just nybble -> do
-            uartSend.put byte
-            state := WaitingForValueNybble2 addr nybble
-          Nothing -> return ()
-      "get_nybble_2": when WaitingForValueNybble2 addr value <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just nybble -> do
-            uartSend.put byte
-            state := WaitingForValueNybble3 addr (value ++ nybble)
-          Nothing -> return ()
-      "get_nybble_3": when WaitingForValueNybble3 addr value <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just nybble -> do
-            uartSend.put byte
-            state := WaitingForValueNybble4 addr (value ++ nybble)
-          Nothing -> return ()
-      "get_nybble_4": when WaitingForValueNybble4 addr value <- state ==> do
-        byte <- uartRecv.get
-        case hexToBits byte of
-          Just nybble -> do
-            uartSend.put byte
-            ebr.portA.request.put (BRAMRequest
-              { write = True
-              ; responseOnWrite = False
-              ; address = addr
-              ; datain = value ++ nybble
-              })
-            state := WritingCR
-          Nothing -> return ()
-
-    interface App
-      led = led
-
--- vim: set ft=haskell :
diff --git a/fpga/src/CPU.bs b/fpga/src/CPU.bs
new file mode 100644
index 0000000..566ae92
--- /dev/null
+++ b/fpga/src/CPU.bs
@@ -0,0 +1,20 @@
+package CPU where
+
+import GetPut
+
+-- | The interface the CPU exposes.
+interface CPU =
+  -- UART
+  uart_tx :: Get (Bit 8)
+  uart_rx :: Put (Bit 8)
+
+mkCPU :: Module CPU
+mkCPU = module
+  byte :: Reg (Bit 8) <- mkReg 0
+
+  interface CPU
+    uart_tx = toGet byte
+    uart_rx = toPut $ \b -> do
+      byte := b
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/Top.bs b/fpga/src/Top.bs
index 9afaaab..924b19a 100644
--- a/fpga/src/Top.bs
+++ b/fpga/src/Top.bs
@@ -1,8 +1,12 @@
+-- | The top-level module, for both simulation and the iCEBreaker.
 package Top where
 
-import App
+import Connectable
+import CPU
+import GetPut
 import Uart
 
+-- | The interface to the iCEBreaker.
 interface Top =
   -- RS232
   rx :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [RX] #-}
@@ -14,6 +18,25 @@ interface Top =
   ledRed_N :: Bit 1 {-# always_ready, result = LED_RED_N #-}
   ledGrn_N :: Bit 1 {-# always_ready, result = LED_GRN_N #-}
   ledBlu_N :: Bit 1 {-# always_ready, result = LED_BLU_N #-}
+  -- HyperBus 1 (PMOD 1A)
+  hyperBus_CS2_N   :: Bit 1 {-# always_ready, result = P1A1 #-}
+  hyperBus_CS0_N   :: Bit 1 {-# always_ready, result = P1A2 #-}
+  hyperBus_CK      :: Bit 1 {-# always_ready, result = P1A3 #-}
+  hyperBus_CK_N    :: Bit 1 {-# always_ready, result = P1A4 #-}
+  hyperBus_CS3_N   :: Bit 1 {-# always_ready, result = P1A7 #-}
+  hyperBus_CS1_N   :: Bit 1 {-# always_ready, result = P1A8 #-}
+  hyperBus_RESET_N :: Bit 1 {-# always_ready, result = P1A9 #-}
+  hyperBus_RWDS    :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [P1A10] #-}
+  -- HyperBus 2 (PMOD 1B)
+  -- hyperBus_DQ0_i :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [P1B1] #-}
+  -- hyperBus_DQ0 :: Inout (Bit 1) {-# always_ready, result = P1B1 #-}
+  -- hyperBus_DQ1 :: Bit 1 {-# always_ready, result = P1B2 #-}
+  -- hyperBus_DQ2 :: Bit 1 {-# always_ready, result = P1B3 #-}
+  -- hyperBus_DQ3 :: Bit 1 {-# always_ready, result = P1B4 #-}
+  -- hyperBus_DQ7 :: Bit 1 {-# always_ready, result = P1B7 #-}
+  -- hyperBus_DQ6 :: Bit 1 {-# always_ready, result = P1B8 #-}
+  -- hyperBus_DQ5 :: Bit 1 {-# always_ready, result = P1B9 #-}
+  -- hyperBus_DQ4 :: Bit 1 {-# always_ready, result = P1B10 #-}
   -- LEDs and buttons (PMOD 2)
   led1 :: Bit 1 {-# always_ready, result = LED1 #-}
   led2 :: Bit 1 {-# always_ready, result = LED2 #-}
@@ -30,8 +53,11 @@ clockFreqHz = 12_000_000
 mkTop :: Module Top
 mkTop =
   module
+    cpu <- mkCPU
+
     uart <- mkUart (clockFreqHz / 9600)
-    app <- mkApp uart.recv uart.send
+    mkConnection cpu.uart_tx uart.send
+    mkConnection cpu.uart_rx uart.recv
 
     interface Top
       -- RS232
@@ -39,21 +65,58 @@ mkTop =
       tx = uart.txPin
       -- Onboard LEDs
       ledR_N = uart.txPin
-      ledG_N = 1 - app.led
+      ledG_N = 1
       -- RGB LED driver
       ledRed_N = 1
       ledGrn_N = 1
       ledBlu_N = 1
+      -- HyperBus 1 (PMOD 1A)
+      hyperBus_CS2_N   = 1
+      hyperBus_CS0_N   = 1
+      hyperBus_CK      = 0
+      hyperBus_CK_N    = 1
+      hyperBus_CS3_N   = 1
+      hyperBus_CS1_N   = 1
+      hyperBus_RESET_N = 1
+      hyperBus_RWDS _ = noAction
       -- LEDs and buttons (PMOD 2)
       led1 = 0
       led2 = 0
       led3 = 0
       led4 = 0
       led5 = 0
-      btn1 _ = return ()
-      btn2 _ = return ()
-      btn3 _ = return ()
+      btn1 _ = noAction
+      btn2 _ = noAction
+      btn3 _ = noAction
 {-# verilog mkTop #-}
 {-# properties mkTop = { RSTN = BTN_N } #-}
 
+mkTopSim :: Module Empty
+mkTopSim =
+  module
+    cpu <- mkCPU
+
+    uart <- mkUart 1
+    mkConnection cpu.uart_tx uart.send
+    mkConnection cpu.uart_rx uart.recv
+
+    fakeUart <- mkUart 1
+    rules
+      when True ==> uart.rxPin fakeUart.txPin
+
+    timer :: Reg (Bit 8) <- mkReg 0
+    rules
+      when True ==> timer := timer + 1
+      when (timer == 0x00) ==> fakeUart.send.put 0x30
+      when (timer == 0x01) ==> fakeUart.send.put 0x30
+      when (timer == 0x02) ==> fakeUart.send.put 0x77
+      when (timer == 0x03) ==> fakeUart.send.put 0x31
+      when (timer == 0x04) ==> fakeUart.send.put 0x32
+      when (timer == 0x05) ==> fakeUart.send.put 0x33
+      when (timer == 0x06) ==> fakeUart.send.put 0x34
+      when (timer == 0x10) ==> fakeUart.send.put 0x30
+      when (timer == 0x11) ==> fakeUart.send.put 0x30
+      when (timer == 0x12) ==> fakeUart.send.put 0x72
+      when (timer == 0xff) ==> $finish
+
 -- vim: set ft=haskell :
diff --git a/fpga/src/TopSim.bs b/fpga/src/TopSim.bs
deleted file mode 100644
index d0d17cb..0000000
--- a/fpga/src/TopSim.bs
+++ /dev/null
@@ -1,32 +0,0 @@
-package TopSim where
-
-import App
-import GetPut
-import Uart
-
-mkTopSim :: Module Empty
-mkTopSim =
-  module
-    timer :: Reg (Bit 8) <- mkReg 0
-
-    uart <- mkUart 1
-    app <- mkApp uart.recv uart.send
-
-    fakeUart <- mkUart 1
-
-    rules
-      when True ==> timer := timer + 1
-      when True ==> uart.rxPin fakeUart.txPin
-      when (timer == 0x00) ==> fakeUart.send.put 0x30
-      when (timer == 0x01) ==> fakeUart.send.put 0x30
-      when (timer == 0x02) ==> fakeUart.send.put 0x77
-      when (timer == 0x03) ==> fakeUart.send.put 0x31
-      when (timer == 0x04) ==> fakeUart.send.put 0x32
-      when (timer == 0x05) ==> fakeUart.send.put 0x33
-      when (timer == 0x06) ==> fakeUart.send.put 0x34
-      when (timer == 0x10) ==> fakeUart.send.put 0x30
-      when (timer == 0x11) ==> fakeUart.send.put 0x30
-      when (timer == 0x12) ==> fakeUart.send.put 0x72
-      when (timer == 0xff) ==> $finish
-
--- vim: set ft=haskell :
diff --git a/fpga/src/Uart.bs b/fpga/src/Uart.bs
index 1059a65..b54cfb8 100644
--- a/fpga/src/Uart.bs
+++ b/fpga/src/Uart.bs
@@ -2,7 +2,6 @@ package Uart where
 
 import FIFOF
 import GetPut
-import Util
 
 interface Clock =
   clk :: Bool
diff --git a/fpga/src/Util.bs b/fpga/src/Util.bs
deleted file mode 100644
index ab3074c..0000000
--- a/fpga/src/Util.bs
+++ /dev/null
@@ -1,7 +0,0 @@
-package Util where
-
-when_ :: (Monad m) => Bool -> m () -> m ()
-when_ True  x = x
-when_ False _ = return ()
-
--- vim: set ft=haskell :