From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- j1eforth/Makefile | 12 - j1eforth/README.md | 99 ---- j1eforth/fpga/papilio-pro-j1.xise | 422 -------------- j1eforth/fpga/papilio_pro_j1.bit | Bin 340703 -> 0 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 | 162 ------ 17 files changed, 3090 deletions(-) delete mode 100644 j1eforth/Makefile delete mode 100644 j1eforth/README.md delete mode 100644 j1eforth/fpga/papilio-pro-j1.xise delete mode 100644 j1eforth/fpga/papilio_pro_j1.bit delete mode 100644 j1eforth/fpga/src/Rxunit.vhd delete mode 100644 j1eforth/fpga/src/Txunit.vhd delete mode 100644 j1eforth/fpga/src/clock.vhd delete mode 100644 j1eforth/fpga/src/j1.v delete mode 100644 j1eforth/fpga/src/miniuart.vhd delete mode 100644 j1eforth/fpga/src/papilio-pro-j1.vhd delete mode 100644 j1eforth/fpga/src/papilio-pro.ucf delete mode 100644 j1eforth/fpga/src/utils.vhd delete mode 100644 j1eforth/fpga/test/miniuart2_tb.vhd delete mode 100644 j1eforth/fpga/test/papilio_pro_j1_tb.vhd delete mode 100644 j1eforth/ipv4.4th delete mode 100644 j1eforth/j1.4th delete mode 100644 j1eforth/j1.c (limited to 'j1eforth') diff --git a/j1eforth/Makefile b/j1eforth/Makefile deleted file mode 100644 index 0be1611..0000000 --- a/j1eforth/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -all: j1 j1.bin j1.hex - -j1: j1.c - gcc -o j1 j1.c -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 deleted file mode 100644 index cca83c6..0000000 --- a/j1eforth/README.md +++ /dev/null @@ -1,99 +0,0 @@ -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 deleted file mode 100644 index d41153c..0000000 --- a/j1eforth/fpga/papilio-pro-j1.xise +++ /dev/null @@ -1,422 +0,0 @@ - - - -
- - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/j1eforth/fpga/papilio_pro_j1.bit b/j1eforth/fpga/papilio_pro_j1.bit deleted file mode 100644 index 1c1372f..0000000 Binary files a/j1eforth/fpga/papilio_pro_j1.bit and /dev/null differ diff --git a/j1eforth/fpga/src/Rxunit.vhd b/j1eforth/fpga/src/Rxunit.vhd deleted file mode 100644 index c30a30e..0000000 --- a/j1eforth/fpga/src/Rxunit.vhd +++ /dev/null @@ -1,97 +0,0 @@ -------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index bdf5b5d..0000000 --- a/j1eforth/fpga/src/Txunit.vhd +++ /dev/null @@ -1,100 +0,0 @@ -------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index 31536e7..0000000 --- a/j1eforth/fpga/src/clock.vhd +++ /dev/null @@ -1,78 +0,0 @@ -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 deleted file mode 100644 index db8901a..0000000 --- a/j1eforth/fpga/src/j1.v +++ /dev/null @@ -1,199 +0,0 @@ -/* -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 deleted file mode 100644 index 2ee4f3c..0000000 --- a/j1eforth/fpga/src/miniuart.vhd +++ /dev/null @@ -1,146 +0,0 @@ -------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index 4680c07..0000000 --- a/j1eforth/fpga/src/papilio-pro-j1.vhd +++ /dev/null @@ -1,117 +0,0 @@ -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 deleted file mode 100644 index 338cd2d..0000000 --- a/j1eforth/fpga/src/papilio-pro.ucf +++ /dev/null @@ -1,143 +0,0 @@ -# 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 deleted file mode 100644 index 19eb1f7..0000000 --- a/j1eforth/fpga/src/utils.vhd +++ /dev/null @@ -1,132 +0,0 @@ -------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index 6049582..0000000 --- a/j1eforth/fpga/test/miniuart2_tb.vhd +++ /dev/null @@ -1,128 +0,0 @@ --------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index 3aedf53..0000000 --- a/j1eforth/fpga/test/papilio_pro_j1_tb.vhd +++ /dev/null @@ -1,96 +0,0 @@ --------------------------------------------------------------------------------- --- 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 deleted file mode 100644 index 080686c..0000000 --- a/j1eforth/ipv4.4th +++ /dev/null @@ -1,249 +0,0 @@ -( - 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 deleted file mode 100644 index 7a1a900..0000000 --- a/j1eforth/j1.4th +++ /dev/null @@ -1,910 +0,0 @@ -( - 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 - -0002 constant =major -0000 constant =minor -0040 constant =comp -0080 constant =imed -7f1f constant =mask -0002 constant =cell -0010 constant =base -0008 constant =bksp -000a constant =nl -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 =nl 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 ( -- ) 7002 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 ) 7001 literal @ 1 literal and 0= invert t; -t: tx! ( c -- ) - begin - 7001 literal @ 2 literal and 0= - until 7000 literal ! t; -t: ?key ( -- c ) '?key @execute t; -t: emit ( c -- ) 'emit @execute t; -t: key ( -- c ) - begin - ?key - until 7000 literal @ t; -t: nuf? ( -- t ) ?key dup if drop key =nl 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 =nl 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 =nl 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 ) =major literal 100 literal * =minor 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 deleted file mode 100644 index 926adb5..0000000 --- a/j1eforth/j1.c +++ /dev/null @@ -1,162 +0,0 @@ -#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 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; -} - -static void execute(int entrypoint) -{ - int i = 0; - int j = 0; - int _pc, _t; - int insn = 0x4000 | entrypoint; // first insn: "call entrypoint" - 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: switch (t) { - case 0x7001: _t = 1; break; - case 0x7000: _t = getch(); break; - default: _t = memory[t>>1]; break; - } - 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] */ - switch (t) { - case 0x7002: rsp = 0; break; - case 0x7000: putch(s); break; - default: memory[t>>1]=s; break; /* ! */ - } - t = _t; - break; - } - } - pc = _pc; - insn = memory[pc]; -#if DEBUG - printf("%d: pc: %0.4x; sp: %0.4x\n", i, pc, t); - printf("\td:"); - for (j = 0; j < dsp; j++) { - printf(" %0.4x", d[j]); - } - printf("\n\tr:"); - for (j = 0; j < rsp; j++) { - printf(" %0.4x", r[j]); - } - printf("\n"); -#endif - i++; - } 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