From d4055d119b8db9937d17d43b6234c10057ba30b2 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 6 Jan 2018 20:15:55 +0100 Subject: add J1eForth --- j1eforth/Makefile | 13 + j1eforth/README.md | 99 ++++ j1eforth/fpga/papilio-pro-j1.xise | 422 ++++++++++++++ j1eforth/fpga/papilio_pro_j1.bit | Bin 0 -> 340703 bytes j1eforth/fpga/src/Rxunit.vhd | 97 ++++ j1eforth/fpga/src/Txunit.vhd | 100 ++++ j1eforth/fpga/src/clock.vhd | 78 +++ j1eforth/fpga/src/j1.v | 199 +++++++ j1eforth/fpga/src/miniuart.vhd | 146 +++++ j1eforth/fpga/src/papilio-pro-j1.vhd | 117 ++++ j1eforth/fpga/src/papilio-pro.ucf | 143 +++++ j1eforth/fpga/src/utils.vhd | 132 +++++ j1eforth/fpga/test/miniuart2_tb.vhd | 128 +++++ j1eforth/fpga/test/papilio_pro_j1_tb.vhd | 96 ++++ j1eforth/ipv4.4th | 249 +++++++++ j1eforth/j1.4th | 910 +++++++++++++++++++++++++++++++ j1eforth/j1.c | 186 +++++++ 17 files changed, 3115 insertions(+) create mode 100644 j1eforth/Makefile create mode 100644 j1eforth/README.md create mode 100644 j1eforth/fpga/papilio-pro-j1.xise create mode 100644 j1eforth/fpga/papilio_pro_j1.bit create mode 100644 j1eforth/fpga/src/Rxunit.vhd create mode 100644 j1eforth/fpga/src/Txunit.vhd create mode 100644 j1eforth/fpga/src/clock.vhd create mode 100644 j1eforth/fpga/src/j1.v create mode 100644 j1eforth/fpga/src/miniuart.vhd create mode 100644 j1eforth/fpga/src/papilio-pro-j1.vhd create mode 100644 j1eforth/fpga/src/papilio-pro.ucf create mode 100644 j1eforth/fpga/src/utils.vhd create mode 100644 j1eforth/fpga/test/miniuart2_tb.vhd create mode 100644 j1eforth/fpga/test/papilio_pro_j1_tb.vhd create mode 100644 j1eforth/ipv4.4th create mode 100644 j1eforth/j1.4th create mode 100644 j1eforth/j1.c (limited to 'j1eforth') diff --git a/j1eforth/Makefile b/j1eforth/Makefile new file mode 100644 index 0000000..5ee12db --- /dev/null +++ b/j1eforth/Makefile @@ -0,0 +1,13 @@ +all: j1 j1.bin j1.hex + +j1: j1.c + gcc -o j1 j1.c -lwpcap + strip -s j1 +j1.bin j1.hex: j1.4th + gforth ./j1.4th +run: all + ./j1 +core: all + ./j1 core.4th +clean: + rm -rf j1 j1.bin j1.hex diff --git a/j1eforth/README.md b/j1eforth/README.md new file mode 100644 index 0000000..cca83c6 --- /dev/null +++ b/j1eforth/README.md @@ -0,0 +1,99 @@ +eForth for the J1 Simulator and actual J1 FPGAs +------------- + +J1 eForth is an interactive work-in-progress Forth designed to run on the [James Bowman's J1 FPGA soft core][j1] +(see also [J1 on Github][J1github]). There is a Forth cross compiler written in Forth to +generate the interactice J1 eForth system, and a J1 simulator written in C to run J1 eForth simulated +on a PC. + +J1 eForth also runs on actual J1 FPGAs. It has been ported to the [Papilio Pro][pappro] FPGA board, +where it executes Forth program at 66 MHz. It communicates with a host system using a serial line at a +default speed of 115200 Bits/s. + +### Prerequisites + + - [GNU make][gmake] (optional) for job control + - [gforth][gforth] for cross compiling / generating the J1 eForth image + - [WpdPack][pcap] for network simulation + +If you want to run J1 eForth simulated on a PC: + + - [gcc][gcc] to compile the J1 simulator + +If you want to run J1 eForth on a J1 in an FPGA: + + - [Xilinx ISE][xilinxise] to generate the FPGA bit stream (ISE 14.7) + - [Papilio-Loader][paploader] to download the bitstream to the FPGA + +### Directry Structure + + j1eforth + ├── README.MD + ├── j1.4th cross compiler with J1 eForth + ├── j1.c J1 simulator + └── fpga + ├── src Verilog projects for J1 and UART (miniuart2) for Papilio Pro + └── test testbenches + +### Building and running the j1 Simulator +#### Compiling using gcc Mingw (Windows) + + gcc j1.c -o -lwpcap j1.exe + +#### Creating flash image j1.bin (and j1.hex) + + gforth j1.4th +#### Running the Simulator + + j1.exe [optional argument] + + The argument to the simulator is an optional forth file that can be used to extend the dictionary + and is passed to the simulator as the first argument during startup + + Words to test in the simulator : + + [ see , ' , compile , [compile] , ?branch , branch , call, .. and many more ] + + Have fun , modify and pass on + +### Running on Real Hardware + +J1 eForth can run on an actual j1 FPGA. It has been ported to the [Papilio Pro][pappro] FPGA board. + +#### Create the J1 bit stream: + +Start Xilinx ise on project `vhdl/papiolo-pro-j1.xise` +choose `Generate Programming File` on the `papilio_pro_j1` component. This generates `papilio_pro_j1.bit` +including the Forth image (`j1.hex`) as initial memory (built before when generating the flash image). + +#### Load the complete bit stream (J1 and memory) into the FPGA: + + sudo papilio-prog -v -f papilio_pro_j1.bit + + You might want to use the pre-built `pipilio_pro_j1.bit` for a quick start. + +#### Connect to J1 eForth: + + screen /dev/tty.usbserial 115200 + + or similar. J1 eForth should show the prompt + + eForth j1 v1.04 + ok + + If you only see the **`ok`** prompts issue a **`cold`** and press the enter key to reboot the system. + + +### May the Forth be with you. + +[pappro]: http://papilio.cc/index.php?n=Papilio.PapilioPro +[paploader]: http://papilio.cc/index.php?n=Papilio.PapilioLoaderV2 +[pcap]: http://www.winpcap.org/archive/4.1.1-WpdPack.zip +[j1]: http://www.excamera.com/sphinx/fpga-j1.html +[j1github]: https://github.com/jamesbowman/j1 + +[gmake]: https://www.gnu.org/software/make/ +[gcc]: https://gcc.gnu.org/ +[gforth]: https://www.gnu.org/software/gforth/ + +[xilinxise]: http://www.xilinx.com/products/design-tools/ise-design-suite/ise-webpack.html diff --git a/j1eforth/fpga/papilio-pro-j1.xise b/j1eforth/fpga/papilio-pro-j1.xise new file mode 100644 index 0000000..d41153c --- /dev/null +++ b/j1eforth/fpga/papilio-pro-j1.xise @@ -0,0 +1,422 @@ + + + +
+ + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
diff --git a/j1eforth/fpga/papilio_pro_j1.bit b/j1eforth/fpga/papilio_pro_j1.bit new file mode 100644 index 0000000..1c1372f Binary files /dev/null and b/j1eforth/fpga/papilio_pro_j1.bit differ diff --git a/j1eforth/fpga/src/Rxunit.vhd b/j1eforth/fpga/src/Rxunit.vhd new file mode 100644 index 0000000..c30a30e --- /dev/null +++ b/j1eforth/fpga/src/Rxunit.vhd @@ -0,0 +1,97 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : Rxunit.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: RxUnit is a serial to parallel unit Receiver. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ +library ieee; + use ieee.std_logic_1164.all; + +entity RxUnit is + port ( + Clk : in std_logic; -- system clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + ReadA : in Std_logic; -- Async Read Received Byte + RxD : in std_logic; -- RS-232 data input + RxAv : out std_logic; -- Byte available + DataO : out std_logic_vector(7 downto 0)); -- Byte received +end RxUnit; + +architecture Behaviour of RxUnit is + signal RReg : std_logic_vector(7 downto 0); -- receive register + signal RRegL : std_logic; -- Byte received +begin + -- RxAv process + RxAvProc : process(RRegL,Reset,ReadA) + begin + if ReadA = '1' or Reset = '1' then + RxAv <= '0'; -- Negate RxAv when RReg read + elsif Rising_Edge(RRegL) then + RxAv <= '1'; -- Assert RxAv when RReg written + end if; + end process; + + -- Rx Process + RxProc : process(Clk,Reset,Enable,RxD,RReg) + variable BitPos : INTEGER range 0 to 10; -- Position of the bit in the frame + variable SampleCnt : INTEGER range 0 to 3; -- Count from 0 to 3 in each bit + begin + if Reset = '1' then -- Reset + RRegL <= '0'; + BitPos := 0; + elsif Rising_Edge(Clk) then + if Enable = '1' then + case BitPos is + when 0 => -- idle + RRegL <= '0'; + if RxD = '0' then -- Start Bit + SampleCnt := 0; + BitPos := 1; + end if; + when 10 => -- Stop Bit + BitPos := 0; -- next is idle + RRegL <= '1'; -- Indicate byte received + DataO <= RReg; -- Store received byte + when others => + if (SampleCnt = 1 and BitPos >= 2) then -- Sample RxD on 1 + RReg(BitPos-2) <= RxD; -- Deserialisation + end if; + if SampleCnt = 3 then -- Increment BitPos on 3 + BitPos := BitPos + 1; + end if; + end case; + if SampleCnt = 3 then + SampleCnt := 0; + else + sampleCnt := SampleCnt + 1; + end if; + + end if; + end if; + end process; +end Behaviour; diff --git a/j1eforth/fpga/src/Txunit.vhd b/j1eforth/fpga/src/Txunit.vhd new file mode 100644 index 0000000..bdf5b5d --- /dev/null +++ b/j1eforth/fpga/src/Txunit.vhd @@ -0,0 +1,100 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : Txunit.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: Txunit is a parallel to serial unit transmitter. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ + +library ieee; +use ieee.std_logic_1164.all; + +entity TxUnit is + port ( + Clk : in std_logic; -- Clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + LoadA : in std_logic; -- Asynchronous Load + TxD : out std_logic; -- RS-232 data output + Busy : out std_logic; -- Tx Busy + DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit +end TxUnit; + +architecture Behaviour of TxUnit is + + component synchroniser + port ( + C1 : in std_logic; -- Asynchronous signal + C : in std_logic; -- Clock + O : out Std_logic);-- Synchronised signal + end component; + + signal TBuff : std_logic_vector(7 downto 0); -- transmit buffer + signal TReg : std_logic_vector(7 downto 0); -- transmit register + signal TBufL : std_logic; -- Buffer loaded + signal LoadS : std_logic; -- Synchronised load signal + +begin + -- Synchronise Load on Clk + SyncLoad : Synchroniser port map (LoadA, Clk, LoadS); + Busy <= LoadS or TBufL; + + -- Tx process + TxProc : process(Clk, Reset, Enable, DataI, TBuff, TReg, TBufL) + variable BitPos : INTEGER range 0 to 10; -- Bit position in the frame + begin + if Reset = '1' then + TBufL <= '0'; + BitPos := 0; + TxD <= '1'; + elsif Rising_Edge(Clk) then + if LoadS = '1' then + TBuff <= DataI; + TBufL <= '1'; + end if; + if Enable = '1' then + case BitPos is + when 0 => -- idle or stop bit + TxD <= '1'; + if TBufL = '1' then -- start transmit. next is start bit + TReg <= TBuff; + TBufL <= '0'; + BitPos := 1; + end if; + when 1 => -- Start bit + TxD <= '0'; + BitPos := 2; + when others => + TxD <= TReg(BitPos-2); -- Serialisation of TReg + BitPos := BitPos + 1; + end case; + if BitPos = 10 then -- bit8. next is stop bit + BitPos := 0; + end if; + end if; + end if; + end process; +end Behaviour; diff --git a/j1eforth/fpga/src/clock.vhd b/j1eforth/fpga/src/clock.vhd new file mode 100644 index 0000000..31536e7 --- /dev/null +++ b/j1eforth/fpga/src/clock.vhd @@ -0,0 +1,78 @@ +library ieee; +use ieee.std_logic_1164.ALL; +use ieee.numeric_std.ALL; +library UNISIM; +use UNISIM.Vcomponents.ALL; + +entity clock is + port ( clk_in : in std_logic; + clk : out std_logic; + clk180 : out std_logic); +end clock; + +architecture BEHAVIORAL of clock is + + signal CLKFB_IN : std_logic; + signal CLKFX_BUF : std_logic; + signal CLKFX180_BUF : std_logic; + signal CLKIN_IBUFG : std_logic; + signal CLK2X_BUF : std_logic; + +begin + + CLKFX_BUFG_INST : BUFG + port map (I=>CLKFX_BUF, + O=>clk); + + CLKFX180_BUFG_INST : BUFG + port map (I=>CLKFX180_BUF, + O=>clk180); + + CLKIN_IBUFG_INST : IBUFG + port map (I=>clk_in, + O=>CLKIN_IBUFG); + + CLK2X_BUFG_INST : BUFG + port map (I=>CLK2X_BUF, + O=>CLKFB_IN); + + DCM_SP_INST : DCM_SP + generic map( + CLK_FEEDBACK => "2X", + CLKDV_DIVIDE => 4.0, + CLKFX_DIVIDE => 1, + CLKFX_MULTIPLY => 2, + CLKIN_DIVIDE_BY_2 => FALSE, + CLKIN_PERIOD => 31.250, + CLKOUT_PHASE_SHIFT => "NONE", + DESKEW_ADJUST => "SYSTEM_SYNCHRONOUS", + DFS_FREQUENCY_MODE => "LOW", + DLL_FREQUENCY_MODE => "LOW", + DUTY_CYCLE_CORRECTION=> TRUE, + FACTORY_JF => x"C080", + PHASE_SHIFT => 0, + STARTUP_WAIT => TRUE) + port map ( + CLKIN => CLKIN_IBUFG, + CLKFB => CLKFB_IN, + DSSEN => '0', + PSCLK => '0', + PSEN => '0', + PSINCDEC => '0', + RST => '0', + CLKDV => open, + CLKFX => CLKFX_BUF, + CLKFX180 => CLKFX180_BUF, + CLK2X => CLK2X_BUF, + CLK2X180 => open, + CLK0 => open, + CLK90 => open, + CLK180 => open, + CLK270 => open, + LOCKED => open, + PSDONE => open, + STATUS => open); + +end BEHAVIORAL; + + diff --git a/j1eforth/fpga/src/j1.v b/j1eforth/fpga/src/j1.v new file mode 100644 index 0000000..db8901a --- /dev/null +++ b/j1eforth/fpga/src/j1.v @@ -0,0 +1,199 @@ +/* +Copyright (c) 2011 + James Bowman All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of James Bowman nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. +*/ + +module j1( + input sys_clk_i, input sys_rst_i, input [15:0] io_din, + output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); + + reg [15:0] insn; + wire [15:0] immediate = { 1'b0, insn[14:0] }; + + reg [4:0] dsp; // Data stack pointer + reg [4:0] _dsp; + reg [15:0] st0; // Return stack pointer + reg [15:0] _st0; + wire _dstkW; // D stack write + + reg [12:0] pc; + reg [12:0] _pc; + reg [4:0] rsp; + reg [4:0] _rsp; + reg _rstkW; // R stack write + reg [15:0] _rstkD; + wire _ramWE; // RAM write enable + + wire [15:0] pc_plus_1; + assign pc_plus_1 = pc + 1; + + // The D and R stacks + reg [15:0] dstack[0:31]; + reg [15:0] rstack[0:31]; + always @(posedge sys_clk_i) + begin + if (_dstkW) + dstack[_dsp] = st0; + if (_rstkW) + rstack[_rsp] = _rstkD; + end + wire [15:0] st1 = dstack[dsp]; + wire [15:0] rst0 = rstack[rsp]; + + // st0sel is the ALU operation. For branch and call the operation + // is T, for 0branch it is N. For ALU ops it is loaded from the instruction + // field. + reg [3:0] st0sel; + always @* + begin + case (insn[14:13]) + 2'b00: st0sel = 0; // ubranch + 2'b10: st0sel = 0; // call + 2'b01: st0sel = 1; // 0branch + 2'b11: st0sel = insn[11:8]; // ALU + default: st0sel = 4'bxxxx; + endcase + end + + + // Papilio Pro: main memory to be infered instead of specified explitely. + reg [15:0] ram[0:16383]; initial $readmemh("../j1.hex", ram); + + reg [15:0] mem_din; + always @(posedge sys_clk_i) begin + // $monitor("insn_addr= %h, insn = %h, sp=%h, rp=%h, S=%h %h", pc, insn, dsp, rsp, st1, st0); + insn <= ram[_pc]; + mem_din <= ram[_st0[15:1]]; + if (_ramWE & (_st0[15:14] ==0)) + ram[_st0[15:1]] <= st1[15:0]; + end + + + // Compute the new value of T. + always @* + begin + if (insn[15]) + _st0 = immediate; + else + case (st0sel) + 4'b0000: _st0 = st0; + 4'b0001: _st0 = st1; + 4'b0010: _st0 = st0 + st1; + 4'b0011: _st0 = st0 & st1; + 4'b0100: _st0 = st0 | st1; + 4'b0101: _st0 = st0 ^ st1; + 4'b0110: _st0 = ~st0; + 4'b0111: _st0 = {16{(st1 == st0)}}; + 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; + 4'b1001: _st0 = st1 >> st0[3:0]; + 4'b1010: _st0 = st0 - 1; + 4'b1011: _st0 = rst0; + 4'b1100: _st0 = |st0[15:14] ? io_din : mem_din; + 4'b1101: _st0 = st1 << st0[3:0]; + 4'b1110: _st0 = {rsp, 3'b000, dsp}; + 4'b1111: _st0 = {16{(st1 < st0)}}; + default: _st0 = 16'hxxxx; + endcase + end + + wire is_alu = (insn[15:13] == 3'b011); + wire is_lit = (insn[15]); + + assign io_rd = (is_alu & (insn[11:8] == 4'hc)); + assign io_wr = _ramWE; + assign io_addr = st0; + assign io_dout = st1; + + assign _ramWE = is_alu & insn[5]; + assign _dstkW = is_lit | (is_alu & insn[7]); + + wire [1:0] dd = insn[1:0]; // D stack delta + wire [1:0] rd = insn[3:2]; // R stack delta + + always @* + begin + if (is_lit) begin // literal + _dsp = dsp + 1; + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end else if (is_alu) begin + _dsp = dsp + {dd[1], dd[1], dd[1], dd}; + _rsp = rsp + {rd[1], rd[1], rd[1], rd}; + _rstkW = insn[6]; + _rstkD = st0; + end else begin // jump/call + // predicated jump is like DROP + if (insn[15:13] == 3'b001) begin + _dsp = dsp - 1; + end else begin + _dsp = dsp; + end + if (insn[15:13] == 3'b010) begin // call + _rsp = rsp + 1; + _rstkW = 1; + _rstkD = {pc_plus_1[14:0], 1'b0}; + end else begin + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end + end + end + + always @* + begin + if (sys_rst_i) + _pc = pc; + else + if ((insn[15:13] == 3'b000) | + ((insn[15:13] == 3'b001) & (|st0 == 0)) | + (insn[15:13] == 3'b010)) + _pc = insn[12:0]; + else if (is_alu & insn[12]) + _pc = rst0[15:1]; + else + _pc = pc_plus_1; + end + + always @(posedge sys_clk_i) + begin + if (sys_rst_i) begin + pc <= 0; + dsp <= 0; + st0 <= 0; + rsp <= 0; + end else begin + dsp <= _dsp; + pc <= _pc; + st0 <= _st0; + rsp <= _rsp; + end + end + +endmodule // j1 diff --git a/j1eforth/fpga/src/miniuart.vhd b/j1eforth/fpga/src/miniuart.vhd new file mode 100644 index 0000000..2ee4f3c --- /dev/null +++ b/j1eforth/fpga/src/miniuart.vhd @@ -0,0 +1,146 @@ +------------------------------------------------------------------------------- +-- Title : MINIUART2 -- this is a modified version without Wishbone interface +-- Project : MINIUART2 +------------------------------------------------------------------------------- +-- File : MiniUart.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164, Rxunit.vhd, Txunit.vhd, utils.vhd +------------------------------------------------------------------------------- +-- Description: Uart (Universal Asynchronous Receiver Transmitter) for SoC. +-- Wishbone compatable. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------- +-- Revision History: +-- 2014-12-19: removed wishbone interface (uh@xlerb.de) + + +library ieee; + use ieee.std_logic_1164.all; + +entity MINIUART2 is + generic(BRDIVISOR: INTEGER range 0 to 65535 := 143); -- Baud rate divisor 143 = 115200 at 66 Mhz + port ( + clk: in STD_LOGIC; + rst: in STD_LOGIC; + rx: in STD_LOGIC; + tx: out STD_LOGIC; + io_rd: in STD_LOGIC; + io_wr: in STD_LOGIC; + io_addr: in STD_LOGIC; + io_din: in STD_LOGIC_VECTOR (15 downto 0); + io_dout: out STD_LOGIC_VECTOR (15 downto 0)); +end MINIUART2; + +-- Architecture for UART for synthesis +architecture Behaviour of MINIUART2 is + + component Counter + generic(COUNT: INTEGER range 0 to 65535); -- Count revolution + port ( + Clk : in std_logic; -- Clock + Reset : in std_logic; -- Reset input + CE : in std_logic; -- Chip Enable + O : out std_logic); -- Output + end component; + + component RxUnit + port ( + Clk : in std_logic; -- system clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + ReadA : in Std_logic; -- Async Read Received Byte + RxD : in std_logic; -- RS-232 data input + RxAv : out std_logic; -- Byte available + DataO : out std_logic_vector(7 downto 0)); -- Byte received + end component; + + component TxUnit + port ( + Clk : in std_logic; -- Clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + LoadA : in std_logic; -- Asynchronous Load + TxD : out std_logic; -- RS-232 data output + Busy : out std_logic; -- Tx Busy + DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit + end component; + + signal RxData : std_logic_vector(7 downto 0); -- Last Byte received + signal TxData : std_logic_vector(7 downto 0); -- Last bytes transmitted + signal SReg : std_logic_vector(7 downto 0); -- Status register + signal EnabRx : std_logic; -- Enable RX unit + signal EnabTx : std_logic; -- Enable TX unit + signal RxAv : std_logic; -- Data Received + signal TxBusy : std_logic; -- Transmiter Busy + signal ReadA : std_logic; -- Async Read receive buffer + signal LoadA : std_logic; -- Async Load transmit buffer + signal Sig0 : std_logic; -- gnd signal + signal Sig1 : std_logic; -- vcc signal + + + begin + sig0 <= '0'; + sig1 <= '1'; + Uart_Rxrate : Counter -- Baud Rate adjust + generic map (COUNT => BRDIVISOR) + port map (clk, rst, sig1, EnabRx); + Uart_Txrate : Counter -- 4 Divider for Tx + generic map (COUNT => 4) + port map (clk, rst, EnabRx, EnabTx); + Uart_TxUnit : TxUnit port map (clk, rst, EnabTX, LoadA, tx, TxBusy, TxData); + Uart_RxUnit : RxUnit port map (clk, rst, EnabRX, ReadA, rx, RxAv, RxData); + + -- status register + SReg(0) <= RxAv; + SReg(1) <= TxBusy; + SReg(7 downto 2) <= (others => '0'); -- the rest is silence + + process (clk, rst, io_addr, io_wr, io_din) + begin + if Rising_Edge(clk) then + if rst='1' then + LoadA <= '0'; + elsif io_wr='1' and io_addr='0' then -- write byte to tx + TxData <= io_din(7 downto 0); + LoadA <= '1'; + else + LoadA <= '0'; + end if; + end if; + end process; + + process (clk, rst, io_addr, io_rd, RxData, TxBusy, RxAv) + begin + if Rising_Edge(clk) then + if rst='1' then + ReadA <= '0'; + elsif io_rd='1' and io_addr='0' then + ReadA <= '1'; + else + ReadA <= '0'; + end if; + end if; + end process; + io_dout(7 downto 0) <= RxData when io_addr='0' else SReg; + io_dout(15 downto 8) <= (others => '0'); + +end Behaviour; diff --git a/j1eforth/fpga/src/papilio-pro-j1.vhd b/j1eforth/fpga/src/papilio-pro-j1.vhd new file mode 100644 index 0000000..4680c07 --- /dev/null +++ b/j1eforth/fpga/src/papilio-pro-j1.vhd @@ -0,0 +1,117 @@ +library IEEE; +use IEEE.STD_LOGIC_1164.ALL; +use IEEE.NUMERIC_STD.ALL; + +entity papilio_pro_j1 is + port ( + clk_in: in std_logic; + rx: in std_logic; + tx: out std_logic; + wing: out std_logic_vector(15 downto 0)); +end papilio_pro_j1; + +architecture Behavioral of papilio_pro_j1 is + + component clock is + port ( + clk_in: in std_logic; + clk: out std_logic; + clk180: out std_logic); + end component; + + component j1 is + port ( + sys_clk_i: in std_logic; + sys_rst_i: in std_logic; + io_rd: out std_logic; + io_wr: out std_logic; + io_addr: out std_logic_vector (15 downto 0); + io_din: in std_logic_vector (15 downto 0); + io_dout: out std_logic_vector (15 downto 0)); + end component; + + component miniuart2 is + port ( + clk: in STD_LOGIC; + rst: in STD_LOGIC; + rx: in STD_LOGIC; + tx: out STD_LOGIC; + io_rd: in STD_LOGIC; + io_wr: in STD_LOGIC; + io_addr: in STD_LOGIC; + io_din: in STD_LOGIC_VECTOR (15 downto 0); + io_dout: out STD_LOGIC_VECTOR (15 downto 0)); + end component; + + + signal clk: std_logic; + signal clk180: std_logic; + + signal rst_counter: integer range 0 to 15 := 15; + signal sys_rst: std_logic := '1'; + + signal io_rd: std_logic; + signal io_wr: std_logic; + signal io_addr: std_logic_vector (15 downto 0); + signal io_din: std_logic_vector (15 downto 0); + signal io_dout: std_logic_vector (15 downto 0); + + signal uart_en: std_logic; + signal uart_rd: std_logic; + signal uart_wr: std_logic; + signal uart_dout: std_logic_vector (15 downto 0); +begin + + clock_inst: clock + port map ( + clk_in => clk_in, + clk => clk, + clk180 => clk180); + + j1_inst: j1 + port map ( + sys_clk_i => clk, + sys_rst_i => sys_rst, + io_rd => io_rd, + io_wr => io_wr, + io_addr => io_addr, + io_din => io_din, + io_dout => io_dout); + + uart_inst: miniuart2 + port map( + clk => clk180, + rst => sys_rst, + rx => rx, + tx => tx, + io_rd => uart_rd, + io_wr => uart_wr, + io_addr => io_addr(0), + io_din => io_dout, + io_dout => uart_dout); + + process (clk, rst_counter) + begin + if rising_edge(clk) and rst_counter>0 then + rst_counter <= rst_counter-1; + end if; + end process; + sys_rst <= '1' when rst_counter>0 else '0'; + + uart_en <= '1' when io_addr(15 downto 1)="111100000000000" else '0'; + uart_rd <= io_rd and uart_en; + uart_wr <= io_wr and uart_en; + + process (io_addr, uart_dout) + begin + case io_addr(15 downto 1) is + when "111100000000000" => + io_din <= uart_dout; + when others => + io_din <= (others=>'0'); + end case; + end process; + + wing <= (others=>'0'); + +end Behavioral; \ No newline at end of file diff --git a/j1eforth/fpga/src/papilio-pro.ucf b/j1eforth/fpga/src/papilio-pro.ucf new file mode 100644 index 0000000..338cd2d --- /dev/null +++ b/j1eforth/fpga/src/papilio-pro.ucf @@ -0,0 +1,143 @@ +# UCF file for the Papilio Pro board +# Generated by pin_converter, written by Kevin Lindsey +# https://github.com/thelonious/papilio_pins/tree/development/pin_converter + +# Main board wing pin [] to FPGA pin Pxx map +# -------C------- -------B------- -------A------- +# [GND] [C00] P114 [GND] [B00] P99 P100 [A15] +# [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] +# [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] +# [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] +# [C04] P118 [B04] P84 P85 [A11] [5V0] +# [C05] P119 [B05] P82 P83 [A10] [3V3] +# [C06] P120 [B06] P80 P81 [A09] [2V5] +# [C07] P121 [B07] P78 P79 [A08] [GND] +# [GND] [C08] P123 [GND] [B08] P74 P75 [A07] +# [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] +# [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] +# [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] +# [C12] P131 [B12] P57 P58 [A03] [5V0] +# [C13] P132 [B13] P55 P56 [A02] [3V3] +# [C14] P133 [B14] P50 P51 [A01] [2V5] +# [C15] P134 [B15] P47 P48 [A00] [GND] + +## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. +CONFIG PROHIBIT=P144; +CONFIG PROHIBIT=P69; +CONFIG PROHIBIT=P60; + +NET CLK_IN LOC="P94" | IOSTANDARD=LVTTL | PERIOD=31.25ns; # CLK +NET RX LOC="P101" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # RX +NET TX LOC="P105" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # TX +NET WING(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 +NET WING(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 +NET WING(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 +NET WING(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 +NET WING(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 +NET WING(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 +NET WING(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 +NET WING(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 +NET WING(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 +NET WING(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 +NET WING(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 +NET WING(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 +NET WING(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 +NET WING(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 +NET WING(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 +NET WING(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 +#NET A(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 +#NET A(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 +#NET A(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 +#NET A(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 +#NET A(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 +#NET A(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 +#NET A(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 +#NET A(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 +#NET A(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 +#NET A(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 +#NET A(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 +#NET A(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 +#NET A(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 +#NET A(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 +#NET A(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 +#NET A(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 +#NET B(0) LOC="P99" | IOSTANDARD=LVTTL; # B0 +#NET B(1) LOC="P97" | IOSTANDARD=LVTTL; # B1 +#NET B(2) LOC="P92" | IOSTANDARD=LVTTL; # B2 +#NET B(3) LOC="P87" | IOSTANDARD=LVTTL; # B3 +#NET B(4) LOC="P84" | IOSTANDARD=LVTTL; # B4 +#NET B(5) LOC="P82" | IOSTANDARD=LVTTL; # B5 +#NET B(6) LOC="P80" | IOSTANDARD=LVTTL; # B6 +#NET B(7) LOC="P78" | IOSTANDARD=LVTTL; # B7 +#NET B(8) LOC="P74" | IOSTANDARD=LVTTL; # B8 +#NET B(9) LOC="P95" | IOSTANDARD=LVTTL; # B9 +#NET B(10) LOC="P62" | IOSTANDARD=LVTTL; # B10 +#NET B(11) LOC="P59" | IOSTANDARD=LVTTL; # B11 +#NET B(12) LOC="P57" | IOSTANDARD=LVTTL; # B12 +#NET B(13) LOC="P55" | IOSTANDARD=LVTTL; # B13 +#NET B(14) LOC="P50" | IOSTANDARD=LVTTL; # B14 +#NET B(15) LOC="P47" | IOSTANDARD=LVTTL; # B15 +#NET C(0) LOC="P114" | IOSTANDARD=LVTTL; # C0 +#NET C(1) LOC="P115" | IOSTANDARD=LVTTL; # C1 +#NET C(2) LOC="P116" | IOSTANDARD=LVTTL; # C2 +#NET C(3) LOC="P117" | IOSTANDARD=LVTTL; # C3 +#NET C(4) LOC="P118" | IOSTANDARD=LVTTL; # C4 +#NET C(5) LOC="P119" | IOSTANDARD=LVTTL; # C5 +#NET C(6) LOC="P120" | IOSTANDARD=LVTTL; # C6 +#NET C(7) LOC="P121" | IOSTANDARD=LVTTL; # C7 +#NET C(8) LOC="P123" | IOSTANDARD=LVTTL; # C8 +#NET C(9) LOC="P124" | IOSTANDARD=LVTTL; # C9 +#NET C(10) LOC="P126" | IOSTANDARD=LVTTL; # C10 +#NET C(11) LOC="P127" | IOSTANDARD=LVTTL; # C11 +#NET C(12) LOC="P131" | IOSTANDARD=LVTTL; # C12 +#NET C(13) LOC="P132" | IOSTANDARD=LVTTL; # C13 +#NET C(14) LOC="P133" | IOSTANDARD=LVTTL; # C14 +#NET C(15) LOC="P134" | IOSTANDARD=LVTTL; # C15 +#NET SDRAM_ADDR(0) LOC="P140" | IOSTANDARD=LVTTL; # SDRAM_ADDR0 +#NET SDRAM_ADDR(1) LOC="P139" | IOSTANDARD=LVTTL; # SDRAM_ADDR1 +#NET SDRAM_ADDR(2) LOC="P138" | IOSTANDARD=LVTTL; # SDRAM_ADDR2 +#NET SDRAM_ADDR(3) LOC="P137" | IOSTANDARD=LVTTL; # SDRAM_ADDR3 +#NET SDRAM_ADDR(4) LOC="P46" | IOSTANDARD=LVTTL; # SDRAM_ADDR4 +#NET SDRAM_ADDR(5) LOC="P45" | IOSTANDARD=LVTTL; # SDRAM_ADDR5 +#NET SDRAM_ADDR(6) LOC="P44" | IOSTANDARD=LVTTL; # SDRAM_ADDR6 +#NET SDRAM_ADDR(7) LOC="P43" | IOSTANDARD=LVTTL; # SDRAM_ADDR7 +#NET SDRAM_ADDR(8) LOC="P41" | IOSTANDARD=LVTTL; # SDRAM_ADDR8 +#NET SDRAM_ADDR(9) LOC="P40" | IOSTANDARD=LVTTL; # SDRAM_ADDR9 +#NET SDRAM_ADDR(10) LOC="P141" | IOSTANDARD=LVTTL; # SDRAM_ADDR10 +#NET SDRAM_ADDR(11) LOC="P35" | IOSTANDARD=LVTTL; # SDRAM_ADDR11 +#NET SDRAM_ADDR(12) LOC="P34" | IOSTANDARD=LVTTL; # SDRAM_ADDR12 +#NET SDRAM_DATA(0) LOC="P9" | IOSTANDARD=LVTTL; # SDRAM_DATA0 +#NET SDRAM_DATA(1) LOC="P10" | IOSTANDARD=LVTTL; # SDRAM_DATA1 +#NET SDRAM_DATA(2) LOC="P11" | IOSTANDARD=LVTTL; # SDRAM_DATA2 +#NET SDRAM_DATA(3) LOC="P12" | IOSTANDARD=LVTTL; # SDRAM_DATA3 +#NET SDRAM_DATA(4) LOC="P14" | IOSTANDARD=LVTTL; # SDRAM_DATA4 +#NET SDRAM_DATA(5) LOC="P15" | IOSTANDARD=LVTTL; # SDRAM_DATA5 +#NET SDRAM_DATA(6) LOC="P16" | IOSTANDARD=LVTTL; # SDRAM_DATA6 +#NET SDRAM_DATA(7) LOC="P8" | IOSTANDARD=LVTTL; # SDRAM_DATA7 +#NET SDRAM_DATA(8) LOC="P21" | IOSTANDARD=LVTTL; # SDRAM_DATA8 +#NET SDRAM_DATA(9) LOC="P22" | IOSTANDARD=LVTTL; # SDRAM_DATA9 +#NET SDRAM_DATA(10) LOC="P23" | IOSTANDARD=LVTTL; # SDRAM_DATA10 +#NET SDRAM_DATA(11) LOC="P24" | IOSTANDARD=LVTTL; # SDRAM_DATA11 +#NET SDRAM_DATA(12) LOC="P26" | IOSTANDARD=LVTTL; # SDRAM_DATA12 +#NET SDRAM_DATA(13) LOC="P27" | IOSTANDARD=LVTTL; # SDRAM_DATA13 +#NET SDRAM_DATA(14) LOC="P29" | IOSTANDARD=LVTTL; # SDRAM_DATA14 +#NET SDRAM_DATA(15) LOC="P30" | IOSTANDARD=LVTTL; # SDRAM_DATA15 +#NET SDRAM_DQML LOC="P7" | IOSTANDARD=LVTTL; # SDRAM_DQML +#NET SDRAM_DQMH LOC="P17" | IOSTANDARD=LVTTL; # SDRAM_DQMH +#NET SDRAM_BA(0) LOC="P143" | IOSTANDARD=LVTTL; # SDRAM_BA0 +#NET SDRAM_BA(1) LOC="P142" | IOSTANDARD=LVTTL; # SDRAM_BA1 +#NET SDRAM_nWE LOC="P6" | IOSTANDARD=LVTTL; # SDRAM_nWE +#NET SDRAM_nCAS LOC="P5" | IOSTANDARD=LVTTL; # SDRAM_nCAS +#NET SDRAM_nRAS LOC="P2" | IOSTANDARD=LVTTL; # SDRAM_nRAS +#NET SDRAM_CS LOC="P1" | IOSTANDARD=LVTTL; # SDRAM_CS +#NET SDRAM_CLK LOC="P32" | IOSTANDARD=LVTTL; # SDRAM_CLK +#NET SDRAM_CKE LOC="P33" | IOSTANDARD=LVTTL; # SDRAM_CKE +#NET LED1 LOC="P112" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # LED1 +#NET JTAG_TMS LOC="P107" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TMS +#NET JTAG_TCK LOC="P109" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TCK +#NET JTAG_TDI LOC="P110" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDI +#NET JTAG_TDO LOC="P106" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDO +#NET FLASH_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS +#NET FLASH_CK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK +#NET FLASH_SI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI +#NET FLASH_SO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST | PULLUP; # FLASH_SO diff --git a/j1eforth/fpga/src/utils.vhd b/j1eforth/fpga/src/utils.vhd new file mode 100644 index 0000000..19eb1f7 --- /dev/null +++ b/j1eforth/fpga/src/utils.vhd @@ -0,0 +1,132 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : utils.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: VHDL utility file +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------- +-- Revision list +-- Version Author Date Changes +-- +-- 1.0 Philippe CARTON 19 December 2001 New model +-- philippe.carton2@libertysurf.fr +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Synchroniser: +-- Synchronize an input signal (C1) with an input clock (C). +-- The result is the O signal which is synchronous of C, and persist for +-- one C clock period. +-------------------------------------------------------------------------------- +library IEEE,STD; +use IEEE.std_logic_1164.all; + +entity synchroniser is + port ( + C1 : in std_logic;-- Asynchronous signal + C : in std_logic;-- Clock + O : out std_logic);-- Synchronised signal +end synchroniser; + +architecture Behaviour of synchroniser is + signal C1A : std_logic; + signal C1S : std_logic; + signal R : std_logic; +begin + RiseC1A : process(C1,R) + begin + if Rising_Edge(C1) then + C1A <= '1'; + end if; + if (R = '1') then + C1A <= '0'; + end if; + end process; + + SyncP : process(C,R) + begin + if Rising_Edge(C) then + if (C1A = '1') then + C1S <= '1'; + else C1S <= '0'; + end if; + if (C1S = '1') then + R <= '1'; + else R <= '0'; + end if; + end if; + if (R = '1') then + C1S <= '0'; + end if; + end process; + O <= C1S; +end Behaviour; + +------------------------------------------------------------------------------- +-- Counter +-- This counter is a parametrizable clock divider. +-- The count value is the generic parameter Count. +-- It is CE enabled. (it will count only if CE is high). +-- When it overflow, it will emit a pulse on O. +-- It can be reseted to 0. +------------------------------------------------------------------------------- +library IEEE,STD; +use IEEE.std_logic_1164.all; + +entity Counter is + generic(Count: INTEGER range 0 to 65535); -- Count revolution + port ( + Clk : in std_logic; -- Clock + Reset : in std_logic; -- Reset input + CE : in std_logic; -- Chip Enable + O : out std_logic); -- Output +end Counter; + +architecture Behaviour of Counter is +begin + counter : process(Clk,Reset) + variable Cnt : INTEGER range 0 to Count-1; + begin + if Reset = '1' then + Cnt := Count - 1; + O <= '0'; + elsif Rising_Edge(Clk) then + if CE = '1' then + if Cnt = 0 then + O <= '1'; + Cnt := Count - 1; + else + O <= '0'; + Cnt := Cnt - 1; + end if; + else O <= '0'; + end if; + end if; + end process; +end Behaviour; diff --git a/j1eforth/fpga/test/miniuart2_tb.vhd b/j1eforth/fpga/test/miniuart2_tb.vhd new file mode 100644 index 0000000..6049582 --- /dev/null +++ b/j1eforth/fpga/test/miniuart2_tb.vhd @@ -0,0 +1,128 @@ +-------------------------------------------------------------------------------- +-- Company: +-- Engineer: +-- +-- Create Date: 11:48:15 12/20/2014 +-- Design Name: +-- Module Name: /mnt/hgfs/Projects/j1eforth/vhdl/test/miniuart2_tb.vhd +-- Project Name: papilio-pro-forth +-- Target Device: +-- Tool versions: +-- Description: +-- +-- VHDL Test Bench Created by ISE for module: MINIUART2 +-- +-- Dependencies: +-- +-- Revision: +-- Revision 0.01 - File Created +-- Additional Comments: +-- +-- Notes: +-- This testbench has been automatically generated using types std_logic and +-- std_logic_vector for the ports of the unit under test. Xilinx recommends +-- that these types always be used for the top-level I/O of a design in order +-- to guarantee that the testbench will bind correctly to the post-implementation +-- simulation model. +-------------------------------------------------------------------------------- +LIBRARY ieee; +USE ieee.std_logic_1164.ALL; + +-- Uncomment the following library declaration if using +-- arithmetic functions with Signed or Unsigned values +--USE ieee.numeric_std.ALL; + +ENTITY miniuart2_tb IS +END miniuart2_tb; + +ARCHITECTURE behavior OF miniuart2_tb IS + + -- Component Declaration for the Unit Under Test (UUT) + + COMPONENT MINIUART2 + PORT( + clk : IN std_logic; + rst : IN std_logic; + rx : IN std_logic; + tx : OUT std_logic; + io_rd : IN std_logic; + io_wr : IN std_logic; + io_addr : IN std_logic; + io_din : IN std_logic_vector(15 downto 0); + io_dout : OUT std_logic_vector(15 downto 0) + ); + END COMPONENT; + + + --Inputs + signal clk : std_logic := '0'; + signal rst : std_logic := '0'; + signal rx : std_logic := '0'; + signal io_rd : std_logic := '0'; + signal io_wr : std_logic := '0'; + signal io_addr : std_logic := '0'; + signal io_din : std_logic_vector(15 downto 0) := (others => '0'); + + --Outputs + signal tx : std_logic; + signal io_dout : std_logic_vector(15 downto 0); + + -- Clock period definitions + constant clk_period : time := 10 ns; -- 31.25 ns; + +BEGIN + + -- Instantiate the Unit Under Test (UUT) + uut: MINIUART2 PORT MAP ( + clk => clk, + rst => rst, + rx => rx, + tx => tx, + io_rd => io_rd, + io_wr => io_wr, + io_addr => io_addr, + io_din => io_din, + io_dout => io_dout + ); + + -- Clock process definitions + clk_process :process + begin + clk <= '0'; + wait for clk_period/2; + clk <= '1'; + wait for clk_period/2; + end process; + + + -- Stimulus process + stim_proc: process + begin + -- hold reset state for 100 ns. + wait for 100 ns; + + wait for clk_period*5; + + rst <= '1'; + + wait for clk_period*3; + + rst <= '0'; + + wait for clk_period*3; + + -- insert stimulus here + io_din <= X"002A"; + io_addr <= '1'; + io_wr <= '1'; + + wait for clk_period; + + io_addr <= '0'; + io_din <= X"0000"; + io_wr <= '0'; + + wait; + end process; + +END; diff --git a/j1eforth/fpga/test/papilio_pro_j1_tb.vhd b/j1eforth/fpga/test/papilio_pro_j1_tb.vhd new file mode 100644 index 0000000..3aedf53 --- /dev/null +++ b/j1eforth/fpga/test/papilio_pro_j1_tb.vhd @@ -0,0 +1,96 @@ +-------------------------------------------------------------------------------- +-- Company: +-- Engineer: +-- +-- Create Date: 22:12:23 03/03/2012 +-- Design Name: +-- Module Name: /home/ben/prog/PapilioForth/ise/main_tb.vhd +-- Project Name: PapilioForth +-- Target Device: +-- Tool versions: +-- Description: +-- +-- VHDL Test Bench Created by ISE for module: main +-- +-- Dependencies: +-- +-- Revision: +-- Revision 0.01 - File Created +-- Additional Comments: +-- +-- Notes: +-- This testbench has been automatically generated using types std_logic and +-- std_logic_vector for the ports of the unit under test. Xilinx recommends +-- that these types always be used for the top-level I/O of a design in order +-- to guarantee that the testbench will bind correctly to the post-implementation +-- simulation model. +-------------------------------------------------------------------------------- +LIBRARY ieee; +USE ieee.std_logic_1164.ALL; + +-- Uncomment the following library declaration if using +-- arithmetic functions with Signed or Unsigned values +--USE ieee.numeric_std.ALL; + +ENTITY papilio_pro_j1_tb IS +END papilio_pro_j1_tb; + +ARCHITECTURE behavior OF papilio_pro_j1_tb IS + + -- Component Declaration for the Unit Under Test (UUT) + + COMPONENT papilio_pro_j1 + PORT( + clk_in : IN std_logic; + rx : IN std_logic; + tx : OUT std_logic; + wing : INOUT std_logic_vector(15 downto 0) + ); + END COMPONENT; + + + --Inputs + signal clk_in : std_logic := '0'; + signal rx : std_logic := '0'; + + --Outputs + signal tx : std_logic; + signal wing : std_logic_vector(15 downto 0); + + -- Clock period definitions + constant clk_in_period : time := 31.25 ns; + +BEGIN + + -- Instantiate the Unit Under Test (UUT) + uut: papilio_pro_j1 PORT MAP ( + clk_in => clk_in, + rx => rx, + tx => tx, + wing => wing + ); + + -- Clock process definitions + clk_in_process :process + begin + clk_in <= '0'; + wait for clk_in_period/2; + clk_in <= '1'; + wait for clk_in_period/2; + end process; + + + -- Stimulus process + stim_proc: process + begin + -- hold reset state for 100 ns. + wait for 100 ns; + + wait for clk_in_period*50; + + -- insert stimulus here + + wait; + end process; + +END; diff --git a/j1eforth/ipv4.4th b/j1eforth/ipv4.4th new file mode 100644 index 0000000..080686c --- /dev/null +++ b/j1eforth/ipv4.4th @@ -0,0 +1,249 @@ +( + I feel that the Kernel is at it's best for now and that I can proceed + to do some other things. Note that version 1 is just to make the whole + thing work, later on I might look at optimisation where I might have to move + some stuff around so that memory utilization and execution speed efficiency is + achieved.So far the Kernel works without needing tweaks. + + Work in progress: Implementing simple ipv4 for the j1eforth model + + 7 project targets: + + 1. Add multi-tasking support to the Kernel - 0% + 2. Modify j1 sim to use pcap interface for network tx and rx - 0% + 3. ARP - 0% + 4. ICMP - 0% + 5. IP - 0% + 6. UDP - 0% + 7. TCP - 0% + + Hopefully I will get time to do all this and also document the design of + the j1eforth Kernel for those who are starting out with forth and also those + who wish to tinker with the Kernel for fun. +) + +hex + +forth-wordlist >voc forth + +vocabulary ipv4.1 +only forth also ipv4.1 + +ipv4.1 definitions + +variable active_struct + +: field + create over , + + does> + @ active_struct @ + ; + +( ethernet frame ) + +0 + 6 field eth_dest ( 48 bit source address ) + 6 field eth_src ( 48 bit destination address ) + 2 field eth_type ( 16 bit type ) +constant eth_frame% + +( arp message ) + +0 + 2 field arp_hw ( 16 bit hw type ) + 2 field arp_proto ( 16 bit protocol ) + 1 field arp_hlen ( 8 bit hw address length ) + 1 field arp_plen ( 8 bit protocol address length ) + 2 field arp_op ( 16 bit operation ) + 6 field arp_shw ( 48 bit sender hw address ) + 4 field arp_sp ( 32 bit sender ipv4 address ) + 6 field arp_thw ( 48 bit target hw address ) + 4 field arp_tp ( 32 bit target ipv4 address ) +constant arp_message% + +( arp cache ) + +0 + 4 field ac_ip ( 32 bit protocol address ) + 6 field ac_hw ( 48 bit hw address ) +constant arp_cache% + +( ipv4 datagram header ) + +0 + 1 field ip_vhl ( 4 bit version and 4 bit header length ) + 1 field ip_tos ( 8 bit type of service ) + 2 field ip_len ( 16 bit length ) + 2 field ip_id ( 16 bit identification ) + 2 field ip_frags ( 3 bit flags 13 bit fragment offset ) + 1 field ip_ttl ( 8 bit time to live ) + 1 field ip_proto ( 8 bit protocol number ) + 2 field ip_checksum ( 16 bit checksum ) + 4 field ip_source ( 32 bit source address ) + 4 field ip_dest ( 32 bit destination address ) +constant ip_header% + +( icmp header ) + +0 + 1 field icmp_type ( 8 bits type ) + 1 field icmp_code ( 8 bits code ) + 2 field icmp_checksum ( 16 bits checksum ) +constant icmp_header% + +( udp datagram ) + +0 + 2 field udp_source ( 16 bit source port ) + 2 field udp_dest ( 16 bit destination port ) + 2 field udp_len ( 16 bit length ) + 2 field udp_checksum ( 16 bit checksum ) +constant udp_datagram% + +( tcp header ) + +0 + 2 field tcp_source ( 16 bit source port ) + 2 field tcp_dest ( 16 bit destination port ) + 4 field tcp_seq ( 32 bit sequence number ) + 4 field tcp_ack ( 32 bit acknowledgement ) + 1 field tcp_offset ( 8 bit offset ) + 2 field tcp_flags ( 16 bit flags ) + 1 field tcp_window ( 8 bit window size ) + 2 field tcp_checksum ( 16 bit checksum ) + 2 field tcp_urgent ( 16 bit urgent pointer ) +constant tcp_header% + +4000 constant eth_rx_buf + +: htons ( n -- n ) + dup ff and 8 lshift swap ff00 and 8 rshift or ; + +create ip_addr a8c0 , fe0b , +create ip_netmask ffff , 00ff , +create hw_addr bd00 , 333b , 7f05 , + + 8 constant eth_ip_type + 608 constant eth_arp_type +3580 constant eth_rarp_type + +100 constant arp_request_type +200 constant arp_reply_type + +0 constant icmp_echo_reply +8 constant icmp_echo + +0 constant arp_action + +: arp_lookup 0 to arp_action ; +: arp_update 1 to arp_action ; +: arp_insert 2 to arp_action ; +: arp_delete 3 to arp_action ; +: +arp_age 4 to arp_action ; + +: (arp_lookup) cr ." compare" . . ; +: (arp_update) cr ." update" . . ; +: (arp_insert) cr ." insert" ; +: (arp_delete) cr ." delete" ; +: (+arp_age) cr ." age" ; + +: arp_table ( u -- ) + create here over allot swap erase + does> + swap arp_cache% * + + arp_action 0 to arp_action + case + 0 of (arp_lookup) endof + 1 of (arp_update) endof + 2 of (arp_insert) endof + 3 of (arp_delete) endof + 4 of (+arp_age) endof + ." unknown cache option" + endcase ; + +arp_cache% 8 * arp_table arp_cache + +: eth_rx f008 @ ; +: eth_tx f008 ! ; + +: checksum ( address count -- checksum) + over + 0 -rot + do + i @ + i @ over u> if 1+ then + -2 +loop + dup 10 rshift swap ffff and + + dup 10 rshift + + ffff xor ; +: arp_in ( -- ) + eth_frame% active_struct +! + arp_op @ arp_request_type = if + 100 arp_hw ! + eth_ip_type arp_proto ! + 6 arp_hlen c! + 4 arp_plen c! + arp_reply_type arp_op ! + arp_shw arp_thw 6 cmove + hw_addr arp_shw 6 cmove + arp_sp arp_tp 4 cmove + ip_addr arp_sp 4 cmove + arp_thw + eth_rx_buf active_struct ! + eth_dest 6 cmove + hw_addr eth_src 6 cmove + eth_arp_type eth_type ! + eth_tx + else + ( arp_update ) + then ; +: icmp_in + ip_len @ htons + ip_header% active_struct +! + icmp_type c@ 8 = if + 0 icmp_type c! + icmp_checksum @ fff7 = if + 9 icmp_checksum +! + else 8 icmp_checksum +! then + else + cr ." weird icmp packet" + then eth_tx ; +: udp_in cr ." got udp packet." ; +: tcp_in cr ." got tcp packet." ; +: ip_in ( -- ) + eth_frame% active_struct +! + ip_vhl @ 45 = if + ip_proto c@ case + 1 of + ip_source dup ip_dest 4 cmove + ip_addr swap 4 cmove + icmp_in + endof + 6 of tcp_in endof + 17 of udp_in endof + cr ." unknown ip protocol:" + endcase + else + cr ." unsupported ip version detected" + then ; +: process ( -- ) + eth_type @ case + eth_arp_type of arp_in endof + eth_ip_type of ip_in endof + cr ." unknown ethernet protocol" + endcase ; +: pcap_poll + eth_rx_buf active_struct ! + active_struct @ 5dc erase + eth_rx ; +: round + pcap_poll 0 <> if + process + then ; +: main + begin + round + again +; + +( main ) + +forth definitions +ipv4.1 definitions diff --git a/j1eforth/j1.4th b/j1eforth/j1.4th new file mode 100644 index 0000000..e9ea766 --- /dev/null +++ b/j1eforth/j1.4th @@ -0,0 +1,910 @@ +( + eForth 1.04 for j1 Simulator by Edward A., July 2014 + Much of the code is derived from the following sources: + j1 Cross-compiler by James Bowman August 2010 + 8086 eForth 1.0 by Bill Muench and C. H. Ting, 1990 +) + +only forth definitions hex + +wordlist constant meta.1 +wordlist constant target.1 +wordlist constant assembler.1 + +: (order) ( w wid*n n -- wid*n w n ) + dup if + 1- swap >r recurse over r@ xor if + 1+ r> -rot exit then r> drop then ; +: -order ( wid -- ) get-order (order) nip set-order ; +: +order ( wid -- ) dup >r -order get-order r> swap 1+ set-order ; + +: ]asm ( -- ) assembler.1 +order ; immediate + +get-current meta.1 set-current + +: [a] ( "name" -- ) + parse-word assembler.1 search-wordlist 0= + abort" [a]?" compile, ; immediate +: a: ( "name" -- ) + get-current >r assembler.1 set-current + : r> set-current ; + +target.1 +order meta.1 +order + +a: asm[ ( -- ) assembler.1 -order ; immediate + +create tflash 1000 cells here over erase allot + +variable tdp + +: there tdp @ ; +: tc! tflash + c! ; +: tc@ tflash + c@ ; +: t! over ff and over tc! swap 8 rshift swap 1+ tc! ; +: t@ dup tc@ swap 1+ tc@ 8 lshift or ; +: talign there 1 and tdp +! ; +: tc, there tc! 1 tdp +! ; +: t, there t! 2 tdp +! ; +: $literal [char] " word count dup tc, 0 ?do + count tc, loop drop talign ; +: tallot tdp +! ; +: org tdp ! ; + +a: t 0000 ; +a: n 0100 ; +a: t+n 0200 ; +a: t&n 0300 ; +a: t|n 0400 ; +a: t^n 0500 ; +a: ~t 0600 ; +a: n==t 0700 ; +a: n>t 0900 ; +a: t-1 0a00 ; +a: rt 0b00 ; +a: [t] 0c00 ; +a: n<n 0080 or ; +a: t->r 0040 or ; +a: n->[t] 0020 or ; +a: d-1 0003 or ; +a: d+1 0001 or ; +a: r-1 000c or ; +a: r-2 0008 or ; +a: r+1 0004 or ; + +a: alu 6000 or t, ; + +a: return [a] t 1000 or [a] r-1 [a] alu ; +a: branch 2/ 0000 or t, ; +a: ?branch 2/ 2000 or t, ; +a: call 2/ 4000 or t, ; + +a: literal + dup 8000 and if + ffff xor recurse + [a] ~t [a] alu + else + 8000 or t, + then ; + +variable tlast +variable tuser + +0001 constant =ver +0004 constant =ext +0040 constant =comp +0080 constant =imed +7f1f constant =mask +0002 constant =cell +0010 constant =base +0008 constant =bksp +000a constant =lf +000d constant =cr + +4000 constant =em +0000 constant =cold + + 8 constant =vocs +80 constant =us + +=em 100 - constant =tib +=tib =us - constant =up +=cold =us + constant =pick +=pick 100 + constant =code + +: thead + talign + tlast @ t, there tlast ! + parse-word dup tc, 0 ?do count tc, loop drop talign ; +: twords + cr tlast @ + begin + dup tflash + count 1f and type space =cell - t@ + ?dup 0= until ; +: [t] + parse-word target.1 search-wordlist 0= + abort" [t]?" >body @ ; immediate +: [last] tlast @ ; immediate +: ( [char] ) parse 2drop ; immediate +: literal [a] literal ; +: lookback there =cell - t@ ; +: call? lookback e000 and 4000 = ; +: call>goto there =cell - dup t@ 1fff and swap t! ; +: safe? lookback e000 and 6000 = lookback 004c and 0= and ; +: alu>return there =cell - dup t@ 1000 or [a] r-1 swap t! ; +: t: + >in @ thead >in ! + get-current >r target.1 set-current create + r> set-current 947947 talign there , does> @ [a] call ; +: exit + call? if + call>goto else safe? if + alu>return else + [a] return + then + then ; +: t; + 947947 <> if + abort" unstructured" then true if + exit else [a] return then ; +: u: + >in @ thead >in ! + get-current >r target.1 set-current create + r> set-current talign tuser @ dup , + [a] literal exit =cell tuser +! does> @ [a] literal ; +: [u] + parse-word target.1 search-wordlist 0= + abort" [t]?" >body @ =up - =cell + ; immediate +: immediate tlast @ tflash + dup c@ =imed or swap c! ; +: compile-only tlast @ tflash + dup c@ =comp or swap c! ; + + 0 tlast ! + =up tuser ! + +: hex# ( u -- addr len ) 0 <# base @ >r hex =lf hold # # # # r> base ! #> ; +: save-hex ( -- ) + parse-word w/o create-file throw + there 0 do i t@ over >r hex# r> write-file throw 2 +loop + close-file throw ; +: save-target ( -- ) + parse-word w/o create-file throw >r + tflash there r@ write-file throw r> close-file ; + +: begin there ; +: until [a] ?branch ; + +: if there 0 [a] ?branch ; +: skip there 0 [a] branch ; +: then begin 2/ over t@ or swap t! ; +: else skip swap then ; +: while if swap ; +: repeat [a] branch then ; +: again [a] branch ; +: aft drop skip begin swap ; + +: noop ]asm t alu asm[ ; +: + ]asm t+n d-1 alu asm[ ; +: xor ]asm t^n d-1 alu asm[ ; +: and ]asm t&n d-1 alu asm[ ; +: or ]asm t|n d-1 alu asm[ ; +: invert ]asm ~t alu asm[ ; +: = ]asm n==t d-1 alu asm[ ; +: < ]asm nn alu asm[ ; +: dup ]asm t t->n d+1 alu asm[ ; +: drop ]asm n d-1 alu asm[ ; +: over ]asm n t->n d+1 alu asm[ ; +: nip ]asm t d-1 alu asm[ ; +: >r ]asm n t->r r+1 d-1 alu asm[ ; +: r> ]asm rt t->n r-1 d+1 alu asm[ ; +: r@ ]asm rt t->n d+1 alu asm[ ; +: @ ]asm [t] alu asm[ ; +: ! ]asm t n->[t] d-1 alu + n d-1 alu asm[ ; +: dsp ]asm dsp t->n d+1 alu asm[ ; +: lshift ]asm n<>t d-1 alu asm[ ; +: 1- ]asm t-1 alu asm[ ; +: 2r> ]asm rt t->n r-1 d+1 alu + rt t->n r-1 d+1 alu + n t->n alu asm[ ; +: 2>r ]asm n t->n alu + n t->r r+1 d-1 alu + n t->r r+1 d-1 alu asm[ ; +: 2r@ ]asm rt t->n r-1 d+1 alu + rt t->n r-1 d+1 alu + n t->n d+1 alu + n t->n d+1 alu + n t->r r+1 d-1 alu + n t->r r+1 d-1 alu + n t->n alu asm[ ; +: unloop + ]asm t r-1 alu + t r-1 alu asm[ ; + +: dup@ ]asm [t] t->n d+1 alu asm[ ; +: dup>r ]asm t t->r r+1 alu asm[ ; +: 2dupxor ]asm t^n t->n d+1 alu asm[ ; +: 2dup= ]asm n==t t->n d+1 alu asm[ ; +: !nip ]asm t n->[t] d-1 alu asm[ ; +: 2dup! ]asm t n->[t] alu asm[ ; + +: up1 ]asm t d+1 alu asm[ ; +: down1 ]asm t d-1 alu asm[ ; +: copy ]asm n alu asm[ ; + +a: down e for down1 next copy exit ; +a: up e for up1 next noop exit ; + +: for >r begin ; +: next r@ while r> 1- >r repeat r> drop ; + +=pick org + + ]asm down up asm[ + +there constant =pickbody + + copy ]asm return asm[ + 9c ]asm call asm[ bc ]asm branch asm[ + 9a ]asm call asm[ ba ]asm branch asm[ + 98 ]asm call asm[ b8 ]asm branch asm[ + 96 ]asm call asm[ b6 ]asm branch asm[ + 94 ]asm call asm[ b4 ]asm branch asm[ + 92 ]asm call asm[ b2 ]asm branch asm[ + 90 ]asm call asm[ b0 ]asm branch asm[ + 8e ]asm call asm[ ae ]asm branch asm[ + 8c ]asm call asm[ ac ]asm branch asm[ + 8a ]asm call asm[ aa ]asm branch asm[ + 88 ]asm call asm[ a8 ]asm branch asm[ + 86 ]asm call asm[ a6 ]asm branch asm[ + 84 ]asm call asm[ a4 ]asm branch asm[ + 82 ]asm call asm[ a2 ]asm branch asm[ + 80 ]asm call asm[ a0 ]asm branch asm[ + ]asm return asm[ + +=cold org + +0 t, + +there constant =uzero + =base t, ( base ) + 0 t, ( temp ) + 0 t, ( >in ) + 0 t, ( #tib ) + =tib t, ( tib ) + 0 t, ( 'eval ) + 0 t, ( 'abort ) + 0 t, ( hld ) + + ( context ) + + 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, + + ( forth-wordlist ) + + 0 t, ( na, of last definition, linked ) + 0 t, ( wid|0, next or last wordlist in chain ) + 0 t, ( na, wordlist name pointer ) + + ( current ) + + 0 t, ( wid, new definitions ) + 0 t, ( wid, head of chain ) + + 0 t, ( dp ) + 0 t, ( last ) + 0 t, ( '?key ) + 0 t, ( 'emit ) + 0 t, ( 'boot ) + 0 t, ( '\ ) + 0 t, ( '?name ) + 0 t, ( '$,n ) + 0 t, ( 'overt ) + 0 t, ( '; ) + 0 t, ( 'create ) +there constant =ulast +=ulast =uzero - constant =udiff + +=code org + +t: noop noop t; +t: + + t; +t: xor xor t; +t: and and t; +t: or or t; +t: invert invert t; +t: = = t; +t: < < t; +t: u< u< t; +t: swap swap t; +t: u> swap u< t; +t: dup dup t; +t: drop drop t; +t: over over t; +t: nip nip t; +t: lshift lshift t; +t: rshift rshift t; +t: 1- 1- t; +t: >r r> swap >r >r t; compile-only +t: r> r> r> swap >r t; compile-only +t: r@ r> r> dup >r swap >r t; compile-only +t: @ ( a -- w ) @ t; +t: ! ( w a -- ) ! t; + +t: <> = invert t; +t: 0< 0 literal < t; +t: 0= 0 literal = t; +t: > swap < t; +t: 0> 0 literal swap < t; +t: >= < invert t; +t: tuck swap over t; +t: -rot swap >r swap r> t; +t: 2/ 1 literal rshift t; +t: 2* 1 literal lshift t; +t: 1+ 1 literal + t; +t: sp@ dsp ff literal and t; +t: execute ( ca -- ) >r t; +t: bye ( -- ) f002 literal ! t; +t: c@ ( b -- c ) + dup @ swap 1 literal and if + 8 literal rshift else ff literal and then exit t; +t: c! ( c b -- ) + swap ff literal and dup 8 literal lshift or swap + tuck dup @ swap 1 literal and 0 literal = ff literal xor + >r over xor r> and xor swap ! t; +t: um+ ( w w -- w cy ) + over over + >r + r@ 0 literal >= >r + over over and + 0< r> or >r + or 0< r> and invert 1+ + r> swap t; +t: dovar ( -- a ) r> t; compile-only +t: up dovar =up t, t; +t: douser ( -- a ) up @ r> @ + t; compile-only + +u: base +u: temp +u: >in +u: #tib +u: tib +u: 'eval +u: 'abort +u: hld +u: context + =vocs =cell * tuser +! +u: forth-wordlist + =cell tuser +! + =cell tuser +! +u: current + =cell tuser +! +u: dp +u: last +u: '?key +u: 'emit +u: 'boot +u: '\ +u: 'name? +u: '$,n +u: 'overt +u: '; +u: 'create + +t: ?dup ( w -- w w | 0 ) dup if dup then exit t; +t: rot ( w1 w2 w3 -- w2 w3 w1 ) >r swap r> swap t; +t: 2drop ( w w -- ) drop drop t; +t: 2dup ( w1 w2 -- w1 w2 w1 w2 ) over over t; +t: negate ( n -- -n ) invert 1+ t; +t: dnegate ( d -- -d ) + invert >r invert 1 literal um+ r> + t; +t: - ( n1 n2 -- n1-n2 ) negate + t; +t: abs ( n -- n ) dup 0< if negate then exit t; +t: max ( n n -- n ) 2dup > if drop exit then nip t; +t: min ( n n -- n ) 2dup < if drop exit then nip t; +t: within ( u ul uh -- t ) over - >r - r> u< t; +t: um/mod ( udl udh u -- ur uq ) + 2dup u< if + negate f literal + for >r dup um+ >r >r dup um+ r> + dup + r> r@ swap >r um+ r> or if + >r drop 1+ r> + else + drop + then r> + next drop swap exit + then drop 2drop -1 literal dup t; +t: m/mod ( d n -- r q ) + dup 0< dup >r if + negate >r dnegate r> + then >r dup 0< if + r@ + + then r> um/mod r> if + swap negate swap then exit t; +t: /mod ( n n -- r q ) over 0< swap m/mod t; +t: mod ( n n -- r ) /mod drop t; +t: / ( n n -- q ) /mod nip t; +t: um* ( u u -- ud ) + 0 literal swap f literal + for dup um+ >r >r dup um+ r> + r> if + >r over um+ r> + then + next rot drop t; +t: * ( n n -- n ) um* drop t; +t: m* ( n n -- d ) + 2dup xor 0< >r abs swap abs um* r> if + dnegate then exit t; +t: */mod ( n1 n2 n3 -- r q ) >r m* r> m/mod t; +t: */ ( n1 n2 n3 -- q ) */mod nip t; +t: cell+ ( a -- a ) =cell literal + t; +t: cell- ( a -- a ) =cell literal - t; +t: cells ( n -- n ) 1 literal lshift t; +t: bl ( -- 32 ) 20 literal t; +t: >char ( c -- c ) + 7f literal and dup 7f literal bl within if + drop 5f literal then exit t; +t: +! ( n a -- ) tuck @ + swap ! t; +t: 2! ( d a -- ) swap over ! cell+ ! t; +t: 2@ ( a -- d ) dup cell+ @ swap @ t; +t: count ( b -- b +n ) dup 1+ swap c@ t; +t: here ( -- a ) dp @ t; +t: aligned ( b -- a ) + dup 0 literal =cell literal um/mod drop dup if + =cell literal swap - then + t; +t: align ( -- ) here aligned dp ! t; +t: pad ( -- a ) here 50 literal + aligned t; +t: @execute ( a -- ) @ ?dup if execute then exit t; +t: fill ( b u c -- ) + swap for swap aft 2dup c! 1+ then next 2drop t; +t: erase 0 literal fill t; +t: digit ( u -- c ) 9 literal over < 7 literal and + 30 literal + t; +t: extract ( n base -- n c ) 0 literal swap um/mod swap digit t; +t: <# ( -- ) pad hld ! t; +t: hold ( c -- ) hld @ 1- dup hld ! c! t; +t: # ( u -- u ) base @ extract hold t; +t: #s ( u -- 0 ) begin # dup while repeat t; +t: sign ( n -- ) 0< if 2d literal hold then exit t; +t: #> ( w -- b u ) drop hld @ pad over - t; +t: str ( n -- b u ) dup >r abs <# #s r> sign #> t; +t: hex ( -- ) 10 literal base ! t; +t: decimal ( -- ) a literal base ! t; +t: digit? ( c base -- u t ) + >r 30 literal - 9 literal over < if + dup 20 literal > if + 20 literal - + then + 7 literal - dup a literal < or + then dup r> u< t; +t: number? ( a -- n t | a f ) + base @ >r 0 literal over count + over c@ 24 literal = if + hex swap 1+ swap 1- then + over c@ 2d literal = >r + swap r@ - swap r@ + ?dup if + 1- + for dup >r c@ base @ digit? + while swap base @ * + r> 1+ + next r@ nip if + negate then swap + else r> r> 2drop 2drop 0 literal + then dup + then r> 2drop r> base ! t; +t: ?rx ( -- c t | f ) f001 literal @ 1 literal and 0= invert t; +t: tx! ( c -- ) + begin + f001 literal @ 2 literal and 0= + until f000 literal ! t; +t: ?key ( -- c ) '?key @execute t; +t: emit ( c -- ) 'emit @execute t; +t: key ( -- c ) + begin + ?key + until f000 literal @ t; +t: nuf? ( -- t ) ?key dup if drop key =cr literal = then exit t; +t: space ( -- ) bl emit t; +t: spaces ( +n -- ) 0 literal max for aft space then next t; +t: type ( b u -- ) for aft count emit then next drop t; +t: cr ( -- ) =cr literal emit =lf literal emit t; +t: do$ ( -- a ) r> r@ r> count + aligned >r swap >r t; compile-only +t: $"| ( -- a ) do$ noop t; compile-only +t: .$ ( a -- ) count type t; +t: ."| ( -- ) do$ .$ t; compile-only +t: .r ( n +n -- ) >r str r> over - spaces type t; +t: u.r ( u +n -- ) >r <# #s #> r> over - spaces type t; +t: u. ( u -- ) <# #s #> space type t; +t: . ( w -- ) base @ a literal xor if u. exit then str space type t; +t: cmove ( b1 b2 u -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop t; +t: pack$ ( b u a -- a ) dup >r 2dup ! 1+ swap cmove r> t; +t: ? ( a -- ) @ . t; +t: (parse) ( b u c -- b u delta ; ) + temp ! over >r dup if + 1- temp @ bl = if + for + count temp @ swap - 0< invert r@ 0> and + while next r> drop 0 literal dup exit + then 1- r> + then over swap + for + count temp @ swap - temp @ bl = if + 0< then + while next dup >r else r> drop dup >r 1- + then over - r> r> - exit + then over r> - t; +t: parse ( c -- b u ; ) + >r + tib @ >in @ + + #tib @ >in @ - r> + (parse) + >in +! t; +t: .( ( -- ) 29 literal parse type t; immediate +t: ( ( -- ) 29 literal parse 2drop t; immediate +t: <\> ( -- ) #tib @ >in ! t; immediate +t: \ ( -- ) '\ @execute t; immediate +t: word ( c -- a ; ) parse here cell+ pack$ t; +t: token ( -- a ; ) bl word t; +t: name> ( na -- ca ) count 1f literal and + aligned t; +t: same? ( a a u -- a a f \ -0+ ) + 1- + for aft over r@ + c@ + over r@ + c@ - ?dup + if r> drop exit then then + next 0 literal t; +t: find ( a va -- ca na | a f ) + swap + dup c@ temp ! + dup @ >r + cell+ swap + begin @ dup + if dup @ =mask literal and r@ xor + if cell+ -1 literal else cell+ temp @ same? then + else r> drop swap cell- swap exit + then + while 2 literal cells - + repeat r> drop nip cell- dup name> swap t; +t: ( a -- ca na | a f ) + context dup 2@ xor if cell- then >r + begin + r> cell+ dup >r @ ?dup + while + find ?dup + until r> drop exit then r> drop 0 literal t; +t: name? ( a -- ca na | a f ) 'name? @execute t; +t: ^h ( bot eot cur -- bot eot cur ) + >r over r@ < dup if + =bksp literal dup emit space + emit then r> + t; +t: tap ( bot eot cur c -- bot eot cur ) + dup emit over c! 1+ t; +t: ktap ( bot eot cur c -- bot eot cur ) + dup =cr literal xor if + =bksp literal xor if + bl tap exit + then ^h exit + then drop nip dup t; +t: accept ( b u -- b u ) + over + over + begin + 2dup xor + while + key dup bl - 7f literal u< if tap else ktap then + repeat drop over - t; +t: query ( -- ) tib @ 50 literal accept #tib ! drop 0 literal >in ! t; +t: abort2 do$ drop t; +t: abort1 space .$ 3f literal emit cr 'abort @execute abort2 t; +t: if do$ abort1 exit then abort2 t; compile-only +t: forget ( -- ) + token name? ?dup if + cell- dup dp ! + @ dup context ! last ! + drop exit + then abort1 t; +t: $interpret ( a -- ) + name? ?dup if + @ =comp literal and + $literal compile-only" execute exit + else number? if + exit then abort1 then t; +t: [ ( -- ) [t] $interpret literal 'eval ! t; immediate +t: .ok ( -- ) + [t] $interpret literal 'eval @ = if + ."| $literal ok" + then cr t; +t: eval ( -- ) + begin + token dup c@ + while + 'eval @execute + repeat drop .ok t; +t: $eval ( a u -- ) + >in @ >r #tib @ >r tib @ >r + [t] >in literal 0 literal swap ! + #tib ! tib ! eval r> tib ! r> #tib ! r> >in ! t; compile-only +t: preset ( -- ) =tib literal #tib cell+ ! t; +t: quit ( -- ) + [ begin + query eval + again t; +t: abort drop preset .ok quit t; +t: ' ( -- ca ) token name? if exit then abort1 t; +t: allot ( n -- ) aligned dp +! t; +t: , ( w -- ) here dup cell+ dp ! ! t; +t: call, ( ca -- ) 1 literal rshift 4000 literal or , t; compile-only +t: ?branch ( ca -- ) 1 literal rshift 2000 literal or , t; compile-only +t: branch ( ca -- ) 1 literal rshift 0000 literal or , t; compile-only +t: [compile] ( -- ; ) ' call, t; immediate +t: compile ( -- ) r> dup @ , cell+ >r t; compile-only +t: recurse last @ name> call, t; immediate +t: pick dup 2* 2* =pickbody literal + >r t; +t: literal ( w -- ) + dup 8000 literal and if + ffff literal xor [t] literal ]asm call asm[ compile invert + else + 8000 literal or , + then exit t; immediate +t: ['] ' [t] literal ]asm call asm[ t; immediate +t: $," ( -- ) 22 literal parse here pack$ count + aligned dp ! t; +t: for ( -- a ) compile [t] >r ]asm call asm[ here t; compile-only immediate +t: begin ( -- a ) here t; compile-only immediate +t: (next) ( n -- ) r> r> ?dup if 1- >r @ >r exit then cell+ >r t; compile-only +t: next ( -- ) compile (next) , t; compile-only immediate +t: (do) ( limit index -- index ) r> dup >r swap rot >r >r cell+ >r t; compile-only +t: do ( limit index -- ) compile (do) 0 literal , here t; compile-only immediate +t: (leave) r> drop r> drop r> drop t; compile-only +t: leave compile (leave) noop t; compile-only immediate +t: (loop) + r> r> 1+ r> 2dup <> if + >r >r @ >r exit + then >r 1- >r cell+ >r t; compile-only +t: (unloop) r> r> drop r> drop r> drop >r t; compile-only +t: unloop compile (unloop) noop t; compile-only immediate +t: (?do) + 2dup <> if + r> dup >r swap rot >r >r cell+ >r exit + then 2drop exit t; compile-only +t: ?do ( limit index -- ) compile (?do) 0 literal , here t; compile-only immediate +t: loop ( -- ) compile (loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate +t: (+loop) + r> swap r> r> 2dup - >r + 2 literal pick r@ + r@ xor 0< 0= + 3 literal pick r> xor 0< 0= or if + >r + >r @ >r exit + then >r >r drop cell+ >r t; compile-only +t: +loop ( n -- ) compile (+loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate +t: (i) ( -- index ) r> r> tuck >r >r t; compile-only +t: i ( -- index ) compile (i) noop t; compile-only immediate +t: until ( a -- ) ?branch t; compile-only immediate +t: again ( a -- ) branch t; compile-only immediate +t: if ( -- a ) here 0 literal ?branch t; compile-only immediate +t: then ( a -- ) here 1 literal rshift over @ or swap ! t; compile-only immediate +t: repeat ( a a -- ) branch [t] then ]asm call asm[ t; compile-only immediate +t: skip here 0 literal branch t; compile-only immediate +t: aft ( a -- a a ) drop [t] skip ]asm call asm[ [t] begin ]asm call asm[ swap t; compile-only immediate +t: else ( a -- a ) [t] skip ]asm call asm[ swap [t] then ]asm call asm[ t; compile-only immediate +t: while ( a -- a a ) [t] if ]asm call asm[ swap t; compile-only immediate +t: (case) r> swap >r >r t; compile-only +t: case compile (case) 30 literal t; compile-only immediate +t: (of) r> r@ swap >r = t; compile-only +t: of compile (of) [t] if ]asm call asm[ t; compile-only immediate +t: endof [t] else ]asm call asm[ 31 literal t; compile-only immediate +t: (endcase) r> r> drop >r t; +t: endcase + begin + dup 31 literal = + while + drop + [t] then ]asm call asm[ + repeat + 30 literal <> $literal bad case construct." + compile (endcase) noop t; compile-only immediate +t: $" ( -- ; ) compile $"| $," t; compile-only immediate +t: ." ( -- ; ) compile ."| $," t; compile-only immediate +t: >body ( ca -- pa ) cell+ t; +t: (to) ( n -- ) r> dup cell+ >r @ ! t; compile-only +t: to ( n -- ) compile (to) ' >body , t; compile-only immediate +t: (+to) ( n -- ) r> dup cell+ >r @ +! t; compile-only +t: +to ( n -- ) compile (+to) ' >body , t; compile-only immediate +t: get-current ( -- wid ) current @ t; +t: set-current ( wid -- ) current ! t; +t: definitions ( -- ) context @ set-current t; +t: ?unique ( a -- a ) + dup get-current find if ."| $literal redef " over .$ then drop t; +t: <$,n> ( na -- ) + dup c@ if + ?unique + dup count + aligned + dp ! + dup last ! + cell- + get-current @ + swap ! exit + then drop $"| $literal name" abort1 t; +t: $,n ( na -- ) '$,n @execute t; +t: $compile ( a -- ) + name? ?dup if + @ =imed literal and if + execute exit + else call, exit + then + then + number? if + [t] literal ]asm call asm[ exit then abort1 t; +t: abort" compile $," t; immediate +t: ( -- ) last @ get-current ! t; +t: overt ( -- ) 'overt @execute t; +t: exit r> drop t; +t: <;> ( -- ) + compile [t] exit ]asm call asm[ + [ overt 0 literal here ! t; compile-only immediate +t: ; ( -- ) '; @execute t; compile-only immediate +t: ] ( -- ) [t] $compile literal 'eval ! t; +t: : ( -- ; ) token $,n ] t; +t: immediate ( -- ) =imed literal last @ @ or last @ ! t; +t: user ( u -- ; ) token $,n overt compile douser , t; +t: ( -- ; ) token $,n overt [t] dovar ]asm literal asm[ call, t; +t: create ( -- ; ) 'create @execute t; +t: variable ( -- ; ) create 0 literal , t; +t: (does>) ( -- ) + r> 1 literal rshift here 1 literal rshift + last @ name> dup cell+ ]asm 8000 literal asm[ or , ! , t; compile-only +t: compile-only ( -- ) =comp literal last @ @ or last @ ! t; +t: does> ( -- ) compile (does>) noop t; immediate +t: char ( -- char ) ( -- c ) bl word 1+ c@ t; +t: [char] char [t] literal ]asm call asm[ t; immediate +t: constant create , (does>) @ t; +t: defer create 0 literal , + (does>) + @ ?dup 0 literal = + $literal uninitialized" execute t; +t: is ' >body ! t; immediate +t: .id ( na -- ) + ?dup if + count 1f literal and type exit then + cr ."| $literal {noname}" t; +t: wordlist ( -- wid ) align here 0 literal , dup current cell+ dup @ , ! 0 literal , t; +t: order@ ( a -- u*wid u ) dup @ dup if >r cell+ order@ r> swap 1+ exit then nip t; +t: get-order ( -- u*wid u ) context order@ t; +t: >wid ( wid -- ) cell+ t; +t: .wid ( wid -- ) + space dup >wid cell+ @ ?dup if .id drop exit then 0 literal u.r t; +t: !wid ( wid -- ) >wid cell+ last @ swap ! t; +t: vocs ( -- ) ( list all wordlists ) + cr ."| $literal vocs:" current cell+ + begin + @ ?dup + while + dup .wid >wid + repeat t; +t: order ( -- ) ( list search order ) + cr ."| $literal search:" get-order + begin + ?dup + while + swap .wid 1- + repeat + cr ."| $literal define:" get-current .wid t; +t: set-order ( u*wid n -- ) ( 16.6.1.2197 ) + dup -1 literal = if + drop forth-wordlist 1 literal then + =vocs literal over u< $literal over size of #vocs" + context swap + begin + dup + while + >r swap over ! cell+ r> + 1- + repeat swap ! t; +t: only ( -- ) -1 literal set-order t; +t: also ( -- ) get-order over swap 1+ set-order t; +t: previous ( -- ) get-order swap drop 1- set-order t; +t: >voc ( wid 'name' -- ) + create dup , !wid + (does>) + @ >r get-order swap drop r> swap set-order t; +t: widof ( "vocabulary" -- wid ) ' >body @ t; +t: vocabulary ( 'name' -- ) wordlist >voc t; +t: _type ( b u -- ) for aft count >char emit then next drop t; +t: dm+ ( a u -- a ) + over 4 literal u.r space + for aft count 3 literal u.r then next t; +t: dump ( a u -- ) + base @ >r hex 10 literal / + for cr 10 literal 2dup dm+ -rot + 2 literal spaces _type + next drop r> base ! t; +t: .s ( ... -- ... ) cr sp@ 1- f literal and for r@ pick . next ."| $literal name) ( ca va -- na | f ) + begin + @ ?dup + while + 2dup name> xor + while cell- + repeat nip exit + then drop 0 literal t; +t: >name ( ca -- na | f ) + >r get-order + begin + ?dup + while + swap + r@ swap + (>name) + ?dup if + >r + 1- for aft drop then next + r> r> drop + exit + then + 1- + repeat + r> drop 0 literal t; +t: see ( -- ; ) + ' cr + begin + dup @ ?dup 700c literal xor + while + 3fff literal and 1 literal lshift + >name ?dup if + space .id + else + dup @ 7fff literal and u. + then + cell+ + repeat 2drop t; +t: (words) ( -- ) + cr + begin + @ ?dup + while + dup .id space cell- + repeat t; +t: words + get-order + begin + ?dup + while + swap + cr cr ."| $literal :" dup .wid cr + (words) + 1- + repeat t; +t: ver ( -- n ) =ver literal 100 literal * =ext literal + t; +t: hi ( -- ) + cr ."| $literal eforth j1 v" + base @ hex + ver <# # # 2e literal hold # #> + type base ! cr t; +t: cold ( -- ) + =uzero literal =up literal =udiff literal cmove + preset forth-wordlist dup context ! dup current 2! overt + 4000 literal cell+ dup cell- @ $eval + 'boot @execute + quit + cold t; + +target.1 -order set-current + +there [u] dp t! +[last] [u] last t! +[t] ?rx [u] '?key t! +[t] tx! [u] 'emit t! +[t] <\> [u] '\ t! +[t] $interpret [u] 'eval t! +[t] abort [u] 'abort t! +[t] hi [u] 'boot t! +[t] [u] 'name? t! +[t] [u] 'overt t! +[t] <$,n> [u] '$,n t! +[t] <;> [u] '; t! +[t] [u] 'create t! +[t] cold 2/ =cold t! + +save-target j1.bin +save-hex j1.hex + +meta.1 -order + +bye diff --git a/j1eforth/j1.c b/j1eforth/j1.c new file mode 100644 index 0000000..511d7cf --- /dev/null +++ b/j1eforth/j1.c @@ -0,0 +1,186 @@ +#include +#include +#include +#include +#include +#include +#if defined(unix) || defined(__unix__) || defined(__unix) || (defined(__APPLE__) && defined(__MACH__)) +#include +#include +int getch(void) { /* reads from keypress, doesn't echo */ + struct termios oldattr, newattr; + int ch; + tcgetattr( STDIN_FILENO, &oldattr ); + newattr = oldattr; + newattr.c_iflag &= ~( ICRNL ); + newattr.c_lflag &= ~( ICANON | ECHO ); + tcsetattr( STDIN_FILENO, TCSANOW, &newattr ); + ch = getchar(); + tcsetattr( STDIN_FILENO, TCSANOW, &oldattr ); + // printf("%d\n", ch); + if(ch==0x1b) exit(0); + return ch==127 ? 8 : ch; +} +int putch(int c) { /* output character to sstdout & flush */ + int res=putchar(c); + fflush(stdout); + return res; +} +#endif +int len = 0; +static pcap_t* handle = NULL; +static void pcapdev_init(void) { + char errbuf[PCAP_ERRBUF_SIZE]; + pcap_if_t* devices; + if (pcap_findalldevs(&devices, errbuf) == -1) { + fprintf(stderr, "error pcap_findalldevs: %s\n", errbuf); + return; + } + pcap_if_t* device; + for(device = devices; device; device = device->next) { + if (device->description) { + printf(" (%s)\n", device->description); + } + else { + fprintf(stderr, "no device\n"); + return; + } + } + device = devices->next->next; + if (NULL == (handle= pcap_open_live(device->name + , 65536, 1, 10 , errbuf))) { + fprintf(stderr, "\nUnable to open the adapter. %s is not supported by WinPcap\n"); + pcap_freealldevs(devices); + return; + } + pcap_freealldevs(devices); +} +static unsigned short t; +static unsigned short s; +static unsigned short d[0x20]; /* data stack */ +static unsigned short r[0x20]; /* return stack */ +static unsigned short pc; /* program counter, counts cells */ +static unsigned char dsp, rsp; /* point to top entry */ +static unsigned short* memory; /* ram */ +static int sx[4] = { 0, 1, -2, -1 }; /* 2-bit sign extension */ + +static void push(int v) // push v on the data stack +{ + dsp = 0x1f & (dsp + 1); + d[dsp] = t; + t = v; +} + +static int pop(void) // pop value from the data stack and return it +{ + int v = t; + t = d[dsp]; + dsp = 0x1f & (dsp - 1); + return v; +} +char eth_poll() { + const u_char* packet; + struct pcap_pkthdr* header; + int res = 0; + while (res == 0) + { + res = pcap_next_ex(handle, &header, &packet); + } + len = (int)header->len; + memcpy(&memory[0x2000], packet, len); + return len; +} +void eth_transmit(void) { + if ((pcap_sendpacket(handle, (char *)(&memory[0x2000]), len) == -1)) + { + printf("sorry send error\n"); + exit(1); + } +} + +static void execute(int entrypoint) +{ + int _pc, _t; + int insn = 0x4000 | entrypoint; // first insn: "call entrypoint" + pcapdev_init(); + do { + _pc = pc + 1; + if (insn & 0x8000) { // literal + push(insn & 0x7fff); + } else { + int target = insn & 0x1fff; + switch (insn >> 13) { + case 0: // jump + _pc = target; + break; + case 1: // conditional jump + if (pop() == 0) + _pc = target; + break; + case 2: // call + rsp = 31 & (rsp + 1); + r[rsp] = _pc << 1; + _pc = target; + break; + case 3: // alu + if (insn & 0x1000) {/* r->pc */ + _pc = r[rsp] >> 1; + } + s = d[dsp]; + switch ((insn >> 8) & 0xf) { + case 0: _t = t; break; /* noop */ + case 1: _t = s; break; /* copy */ + case 2: _t = t+s; break; /* + */ + case 3: _t = t&s; break; /* and */ + case 4: _t = t|s; break; /* or */ + case 5: _t = t^s; break; /* xor */ + case 6: _t = ~t; break; /* invert */ + case 7: _t = -(t==s); break; /* = */ + case 8: _t = -((signed short)s < (signed short)t); break; /* < */ + case 9: _t = s>>t; break; /* rshift */ + case 0xa: _t = t-1; break; /* 1- */ + case 0xb: _t = r[rsp]; break; /* r@ */ + case 0xc: _t = (t==0xf008)?eth_poll():(t==0xf001)?1:(t==0xf000)?getch():memory[t>>1]; break; /* @ */ + case 0xd: _t = s<> 2) & 3]); /* rstack+- */ + if (insn & 0x80) /* t->s */ + d[dsp] = t; + if (insn & 0x40) /* t->r */ + r[rsp] = t; + if (insn & 0x20) /* s->[t] */ + (t==0xf008)?eth_transmit(): (t==0xf002)?(rsp=0):(t==0xf000)?putch(s):(memory[t>>1]=s); /* ! */ + t = _t; + break; + } + } + pc = _pc; + insn = memory[pc]; + } while (1); +} +/* end of cpu */ + +/* start of i/o demo */ + + +int main(int argc , char *argv[]) +{ + unsigned short m[0x4000]; /* 32kb or RAM */ + FILE *f = fopen("j1.bin", "rb"); + fread(m, 0x2000, sizeof(m[0]), f); /* 0kb - 16kb data and code */ + fclose(f); + if (argc>1) { // program name is counted as one + struct stat st; + f = fopen(argv[1], "r"); + stat(argv[1], &st); + (&m[0x2000])[0] = st.st_size; /* 16kb - 32kb memory mapped i/o */ + fread(&m[0x2001], 0x2000, sizeof(m[0]), f); + fclose(f); + } + memory = m; + execute(0x00); + return 0; +} -- cgit v1.2.3