├── Makefile ├── README.md ├── fpga ├── papilio-pro-j1.xise ├── papilio_pro_j1.bit ├── src │ ├── Rxunit.vhd │ ├── Txunit.vhd │ ├── clock.vhd │ ├── j1.v │ ├── miniuart.vhd │ ├── papilio-pro-j1.vhd │ ├── papilio-pro.ucf │ └── utils.vhd └── test │ ├── miniuart2_tb.vhd │ └── papilio_pro_j1_tb.vhd ├── ipv4.4th ├── j1.4th └── j1.c /Makefile: -------------------------------------------------------------------------------- 1 | all: j1 j1.bin j1.hex 2 | 3 | j1: j1.c 4 | gcc -o j1 j1.c -lwpcap 5 | strip -s j1 6 | j1.bin j1.hex: j1.4th 7 | gforth ./j1.4th 8 | run: all 9 | ./j1 10 | core: all 11 | ./j1 core.4th 12 | clean: 13 | rm -rf j1 j1.bin j1.hex 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | eForth for the J1 Simulator and actual J1 FPGAs 2 | ------------- 3 | 4 | J1 eForth is an interactive work-in-progress Forth designed to run on the [James Bowman's J1 FPGA soft core][j1] 5 | (see also [J1 on Github][J1github]). There is a Forth cross compiler written in Forth to 6 | generate the interactice J1 eForth system, and a J1 simulator written in C to run J1 eForth simulated 7 | on a PC. 8 | 9 | J1 eForth also runs on actual J1 FPGAs. It has been ported to the [Papilio Pro][pappro] FPGA board, 10 | where it executes Forth program at 66 MHz. It communicates with a host system using a serial line at a 11 | default speed of 115200 Bits/s. 12 | 13 | ### Prerequisites 14 | 15 | - [GNU make][gmake] (optional) for job control 16 | - [gforth][gforth] for cross compiling / generating the J1 eForth image 17 | - [WpdPack][pcap] for network simulation 18 | 19 | If you want to run J1 eForth simulated on a PC: 20 | 21 | - [gcc][gcc] to compile the J1 simulator 22 | 23 | If you want to run J1 eForth on a J1 in an FPGA: 24 | 25 | - [Xilinx ISE][xilinxise] to generate the FPGA bit stream (ISE 14.7) 26 | - [Papilio-Loader][paploader] to download the bitstream to the FPGA 27 | 28 | ### Directry Structure 29 | 30 | j1eforth 31 | ├── README.MD 32 | ├── j1.4th cross compiler with J1 eForth 33 | ├── j1.c J1 simulator 34 | └── fpga 35 | ├── src Verilog projects for J1 and UART (miniuart2) for Papilio Pro 36 | └── test testbenches 37 | 38 | ### Building and running the j1 Simulator 39 | #### Compiling using gcc Mingw (Windows) 40 | 41 | gcc j1.c -o -lwpcap j1.exe 42 | 43 | #### Creating flash image j1.bin (and j1.hex) 44 | 45 | gforth j1.4th 46 | #### Running the Simulator 47 | 48 | j1.exe [optional argument] 49 | 50 | The argument to the simulator is an optional forth file that can be used to extend the dictionary 51 | and is passed to the simulator as the first argument during startup 52 | 53 | Words to test in the simulator : 54 | 55 | [ see , ' , compile , [compile] , ?branch , branch , call, .. and many more ] 56 | 57 | Have fun , modify and pass on 58 | 59 | ### Running on Real Hardware 60 | 61 | J1 eForth can run on an actual j1 FPGA. It has been ported to the [Papilio Pro][pappro] FPGA board. 62 | 63 | #### Create the J1 bit stream: 64 | 65 | Start Xilinx ise on project `vhdl/papiolo-pro-j1.xise` 66 | choose `Generate Programming File` on the `papilio_pro_j1` component. This generates `papilio_pro_j1.bit` 67 | including the Forth image (`j1.hex`) as initial memory (built before when generating the flash image). 68 | 69 | #### Load the complete bit stream (J1 and memory) into the FPGA: 70 | 71 | sudo papilio-prog -v -f papilio_pro_j1.bit 72 | 73 | You might want to use the pre-built `pipilio_pro_j1.bit` for a quick start. 74 | 75 | #### Connect to J1 eForth: 76 | 77 | screen /dev/tty.usbserial 115200 78 | 79 | or similar. J1 eForth should show the prompt 80 | 81 | eForth j1 v1.04 82 | ok 83 | 84 | If you only see the **`ok`** prompts issue a **`cold`** and press the enter key to reboot the system. 85 | 86 | 87 | ### May the Forth be with you. 88 | 89 | [pappro]: http://papilio.cc/index.php?n=Papilio.PapilioPro 90 | [paploader]: http://papilio.cc/index.php?n=Papilio.PapilioLoaderV2 91 | [pcap]: http://www.winpcap.org/archive/4.1.1-WpdPack.zip 92 | [j1]: http://www.excamera.com/sphinx/fpga-j1.html 93 | [j1github]: https://github.com/jamesbowman/j1 94 | 95 | [gmake]: https://www.gnu.org/software/make/ 96 | [gcc]: https://gcc.gnu.org/ 97 | [gforth]: https://www.gnu.org/software/gforth/ 98 | 99 | [xilinxise]: http://www.xilinx.com/products/design-tools/ise-design-suite/ise-webpack.html 100 | -------------------------------------------------------------------------------- /fpga/papilio-pro-j1.xise: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 |
5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 |
14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | 374 | 375 | 376 | 377 | 378 | 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | 387 | 388 | 389 | 390 | 391 | 392 | 393 | 394 | 395 | 396 | 397 | 398 | 399 | 400 | 401 | 402 | 403 | 404 | 405 | 406 | 407 | 408 | 409 | 410 | 411 | 412 | 413 | 414 | 415 | 416 | 417 | 418 | 419 | 420 | 421 | 422 | 423 | -------------------------------------------------------------------------------- /fpga/papilio_pro_j1.bit: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/samawati/j1eforth/49ea12b33191929dd166becb2905e498dec93774/fpga/papilio_pro_j1.bit -------------------------------------------------------------------------------- /fpga/src/Rxunit.vhd: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Title : UART 3 | -- Project : UART 4 | ------------------------------------------------------------------------------- 5 | -- File : Rxunit.vhd 6 | -- Author : Philippe CARTON 7 | -- (philippe.carton2@libertysurf.fr) 8 | -- Organization: 9 | -- Created : 15/12/2001 10 | -- Last update : 8/1/2003 11 | -- Platform : Foundation 3.1i 12 | -- Simulators : ModelSim 5.5b 13 | -- Synthesizers: Xilinx Synthesis 14 | -- Targets : Xilinx Spartan 15 | -- Dependency : IEEE std_logic_1164 16 | ------------------------------------------------------------------------------- 17 | -- Description: RxUnit is a serial to parallel unit Receiver. 18 | ------------------------------------------------------------------------------- 19 | -- Copyright (c) notice 20 | -- This core adheres to the GNU public license 21 | -- 22 | ------------------------------------------------------------------------------- 23 | -- Revisions : 24 | -- Revision Number : 25 | -- Version : 26 | -- Date : 27 | -- Modifier : name 28 | -- Description : 29 | -- 30 | ------------------------------------------------------------------------------ 31 | library ieee; 32 | use ieee.std_logic_1164.all; 33 | 34 | entity RxUnit is 35 | port ( 36 | Clk : in std_logic; -- system clock signal 37 | Reset : in std_logic; -- Reset input 38 | Enable : in std_logic; -- Enable input 39 | ReadA : in Std_logic; -- Async Read Received Byte 40 | RxD : in std_logic; -- RS-232 data input 41 | RxAv : out std_logic; -- Byte available 42 | DataO : out std_logic_vector(7 downto 0)); -- Byte received 43 | end RxUnit; 44 | 45 | architecture Behaviour of RxUnit is 46 | signal RReg : std_logic_vector(7 downto 0); -- receive register 47 | signal RRegL : std_logic; -- Byte received 48 | begin 49 | -- RxAv process 50 | RxAvProc : process(RRegL,Reset,ReadA) 51 | begin 52 | if ReadA = '1' or Reset = '1' then 53 | RxAv <= '0'; -- Negate RxAv when RReg read 54 | elsif Rising_Edge(RRegL) then 55 | RxAv <= '1'; -- Assert RxAv when RReg written 56 | end if; 57 | end process; 58 | 59 | -- Rx Process 60 | RxProc : process(Clk,Reset,Enable,RxD,RReg) 61 | variable BitPos : INTEGER range 0 to 10; -- Position of the bit in the frame 62 | variable SampleCnt : INTEGER range 0 to 3; -- Count from 0 to 3 in each bit 63 | begin 64 | if Reset = '1' then -- Reset 65 | RRegL <= '0'; 66 | BitPos := 0; 67 | elsif Rising_Edge(Clk) then 68 | if Enable = '1' then 69 | case BitPos is 70 | when 0 => -- idle 71 | RRegL <= '0'; 72 | if RxD = '0' then -- Start Bit 73 | SampleCnt := 0; 74 | BitPos := 1; 75 | end if; 76 | when 10 => -- Stop Bit 77 | BitPos := 0; -- next is idle 78 | RRegL <= '1'; -- Indicate byte received 79 | DataO <= RReg; -- Store received byte 80 | when others => 81 | if (SampleCnt = 1 and BitPos >= 2) then -- Sample RxD on 1 82 | RReg(BitPos-2) <= RxD; -- Deserialisation 83 | end if; 84 | if SampleCnt = 3 then -- Increment BitPos on 3 85 | BitPos := BitPos + 1; 86 | end if; 87 | end case; 88 | if SampleCnt = 3 then 89 | SampleCnt := 0; 90 | else 91 | sampleCnt := SampleCnt + 1; 92 | end if; 93 | 94 | end if; 95 | end if; 96 | end process; 97 | end Behaviour; 98 | -------------------------------------------------------------------------------- /fpga/src/Txunit.vhd: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Title : UART 3 | -- Project : UART 4 | ------------------------------------------------------------------------------- 5 | -- File : Txunit.vhd 6 | -- Author : Philippe CARTON 7 | -- (philippe.carton2@libertysurf.fr) 8 | -- Organization: 9 | -- Created : 15/12/2001 10 | -- Last update : 8/1/2003 11 | -- Platform : Foundation 3.1i 12 | -- Simulators : ModelSim 5.5b 13 | -- Synthesizers: Xilinx Synthesis 14 | -- Targets : Xilinx Spartan 15 | -- Dependency : IEEE std_logic_1164 16 | ------------------------------------------------------------------------------- 17 | -- Description: Txunit is a parallel to serial unit transmitter. 18 | ------------------------------------------------------------------------------- 19 | -- Copyright (c) notice 20 | -- This core adheres to the GNU public license 21 | -- 22 | ------------------------------------------------------------------------------- 23 | -- Revisions : 24 | -- Revision Number : 25 | -- Version : 26 | -- Date : 27 | -- Modifier : name 28 | -- Description : 29 | -- 30 | ------------------------------------------------------------------------------ 31 | 32 | library ieee; 33 | use ieee.std_logic_1164.all; 34 | 35 | entity TxUnit is 36 | port ( 37 | Clk : in std_logic; -- Clock signal 38 | Reset : in std_logic; -- Reset input 39 | Enable : in std_logic; -- Enable input 40 | LoadA : in std_logic; -- Asynchronous Load 41 | TxD : out std_logic; -- RS-232 data output 42 | Busy : out std_logic; -- Tx Busy 43 | DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit 44 | end TxUnit; 45 | 46 | architecture Behaviour of TxUnit is 47 | 48 | component synchroniser 49 | port ( 50 | C1 : in std_logic; -- Asynchronous signal 51 | C : in std_logic; -- Clock 52 | O : out Std_logic);-- Synchronised signal 53 | end component; 54 | 55 | signal TBuff : std_logic_vector(7 downto 0); -- transmit buffer 56 | signal TReg : std_logic_vector(7 downto 0); -- transmit register 57 | signal TBufL : std_logic; -- Buffer loaded 58 | signal LoadS : std_logic; -- Synchronised load signal 59 | 60 | begin 61 | -- Synchronise Load on Clk 62 | SyncLoad : Synchroniser port map (LoadA, Clk, LoadS); 63 | Busy <= LoadS or TBufL; 64 | 65 | -- Tx process 66 | TxProc : process(Clk, Reset, Enable, DataI, TBuff, TReg, TBufL) 67 | variable BitPos : INTEGER range 0 to 10; -- Bit position in the frame 68 | begin 69 | if Reset = '1' then 70 | TBufL <= '0'; 71 | BitPos := 0; 72 | TxD <= '1'; 73 | elsif Rising_Edge(Clk) then 74 | if LoadS = '1' then 75 | TBuff <= DataI; 76 | TBufL <= '1'; 77 | end if; 78 | if Enable = '1' then 79 | case BitPos is 80 | when 0 => -- idle or stop bit 81 | TxD <= '1'; 82 | if TBufL = '1' then -- start transmit. next is start bit 83 | TReg <= TBuff; 84 | TBufL <= '0'; 85 | BitPos := 1; 86 | end if; 87 | when 1 => -- Start bit 88 | TxD <= '0'; 89 | BitPos := 2; 90 | when others => 91 | TxD <= TReg(BitPos-2); -- Serialisation of TReg 92 | BitPos := BitPos + 1; 93 | end case; 94 | if BitPos = 10 then -- bit8. next is stop bit 95 | BitPos := 0; 96 | end if; 97 | end if; 98 | end if; 99 | end process; 100 | end Behaviour; 101 | -------------------------------------------------------------------------------- /fpga/src/clock.vhd: -------------------------------------------------------------------------------- 1 | library ieee; 2 | use ieee.std_logic_1164.ALL; 3 | use ieee.numeric_std.ALL; 4 | library UNISIM; 5 | use UNISIM.Vcomponents.ALL; 6 | 7 | entity clock is 8 | port ( clk_in : in std_logic; 9 | clk : out std_logic; 10 | clk180 : out std_logic); 11 | end clock; 12 | 13 | architecture BEHAVIORAL of clock is 14 | 15 | signal CLKFB_IN : std_logic; 16 | signal CLKFX_BUF : std_logic; 17 | signal CLKFX180_BUF : std_logic; 18 | signal CLKIN_IBUFG : std_logic; 19 | signal CLK2X_BUF : std_logic; 20 | 21 | begin 22 | 23 | CLKFX_BUFG_INST : BUFG 24 | port map (I=>CLKFX_BUF, 25 | O=>clk); 26 | 27 | CLKFX180_BUFG_INST : BUFG 28 | port map (I=>CLKFX180_BUF, 29 | O=>clk180); 30 | 31 | CLKIN_IBUFG_INST : IBUFG 32 | port map (I=>clk_in, 33 | O=>CLKIN_IBUFG); 34 | 35 | CLK2X_BUFG_INST : BUFG 36 | port map (I=>CLK2X_BUF, 37 | O=>CLKFB_IN); 38 | 39 | DCM_SP_INST : DCM_SP 40 | generic map( 41 | CLK_FEEDBACK => "2X", 42 | CLKDV_DIVIDE => 4.0, 43 | CLKFX_DIVIDE => 1, 44 | CLKFX_MULTIPLY => 2, 45 | CLKIN_DIVIDE_BY_2 => FALSE, 46 | CLKIN_PERIOD => 31.250, 47 | CLKOUT_PHASE_SHIFT => "NONE", 48 | DESKEW_ADJUST => "SYSTEM_SYNCHRONOUS", 49 | DFS_FREQUENCY_MODE => "LOW", 50 | DLL_FREQUENCY_MODE => "LOW", 51 | DUTY_CYCLE_CORRECTION=> TRUE, 52 | FACTORY_JF => x"C080", 53 | PHASE_SHIFT => 0, 54 | STARTUP_WAIT => TRUE) 55 | port map ( 56 | CLKIN => CLKIN_IBUFG, 57 | CLKFB => CLKFB_IN, 58 | DSSEN => '0', 59 | PSCLK => '0', 60 | PSEN => '0', 61 | PSINCDEC => '0', 62 | RST => '0', 63 | CLKDV => open, 64 | CLKFX => CLKFX_BUF, 65 | CLKFX180 => CLKFX180_BUF, 66 | CLK2X => CLK2X_BUF, 67 | CLK2X180 => open, 68 | CLK0 => open, 69 | CLK90 => open, 70 | CLK180 => open, 71 | CLK270 => open, 72 | LOCKED => open, 73 | PSDONE => open, 74 | STATUS => open); 75 | 76 | end BEHAVIORAL; 77 | 78 | 79 | -------------------------------------------------------------------------------- /fpga/src/j1.v: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (c) 2011 3 | James Bowman All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of James Bowman nor the names of its contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 20 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 21 | REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF 24 | USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 25 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 27 | OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | */ 30 | 31 | module j1( 32 | input sys_clk_i, input sys_rst_i, input [15:0] io_din, 33 | output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); 34 | 35 | reg [15:0] insn; 36 | wire [15:0] immediate = { 1'b0, insn[14:0] }; 37 | 38 | reg [4:0] dsp; // Data stack pointer 39 | reg [4:0] _dsp; 40 | reg [15:0] st0; // Return stack pointer 41 | reg [15:0] _st0; 42 | wire _dstkW; // D stack write 43 | 44 | reg [12:0] pc; 45 | reg [12:0] _pc; 46 | reg [4:0] rsp; 47 | reg [4:0] _rsp; 48 | reg _rstkW; // R stack write 49 | reg [15:0] _rstkD; 50 | wire _ramWE; // RAM write enable 51 | 52 | wire [15:0] pc_plus_1; 53 | assign pc_plus_1 = pc + 1; 54 | 55 | // The D and R stacks 56 | reg [15:0] dstack[0:31]; 57 | reg [15:0] rstack[0:31]; 58 | always @(posedge sys_clk_i) 59 | begin 60 | if (_dstkW) 61 | dstack[_dsp] = st0; 62 | if (_rstkW) 63 | rstack[_rsp] = _rstkD; 64 | end 65 | wire [15:0] st1 = dstack[dsp]; 66 | wire [15:0] rst0 = rstack[rsp]; 67 | 68 | // st0sel is the ALU operation. For branch and call the operation 69 | // is T, for 0branch it is N. For ALU ops it is loaded from the instruction 70 | // field. 71 | reg [3:0] st0sel; 72 | always @* 73 | begin 74 | case (insn[14:13]) 75 | 2'b00: st0sel = 0; // ubranch 76 | 2'b10: st0sel = 0; // call 77 | 2'b01: st0sel = 1; // 0branch 78 | 2'b11: st0sel = insn[11:8]; // ALU 79 | default: st0sel = 4'bxxxx; 80 | endcase 81 | end 82 | 83 | 84 | // Papilio Pro: main memory to be infered instead of specified explitely. 85 | reg [15:0] ram[0:16383]; initial $readmemh("../j1.hex", ram); 86 | 87 | reg [15:0] mem_din; 88 | always @(posedge sys_clk_i) begin 89 | // $monitor("insn_addr= %h, insn = %h, sp=%h, rp=%h, S=%h %h", pc, insn, dsp, rsp, st1, st0); 90 | insn <= ram[_pc]; 91 | mem_din <= ram[_st0[15:1]]; 92 | if (_ramWE & (_st0[15:14] ==0)) 93 | ram[_st0[15:1]] <= st1[15:0]; 94 | end 95 | 96 | 97 | // Compute the new value of T. 98 | always @* 99 | begin 100 | if (insn[15]) 101 | _st0 = immediate; 102 | else 103 | case (st0sel) 104 | 4'b0000: _st0 = st0; 105 | 4'b0001: _st0 = st1; 106 | 4'b0010: _st0 = st0 + st1; 107 | 4'b0011: _st0 = st0 & st1; 108 | 4'b0100: _st0 = st0 | st1; 109 | 4'b0101: _st0 = st0 ^ st1; 110 | 4'b0110: _st0 = ~st0; 111 | 4'b0111: _st0 = {16{(st1 == st0)}}; 112 | 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; 113 | 4'b1001: _st0 = st1 >> st0[3:0]; 114 | 4'b1010: _st0 = st0 - 1; 115 | 4'b1011: _st0 = rst0; 116 | 4'b1100: _st0 = |st0[15:14] ? io_din : mem_din; 117 | 4'b1101: _st0 = st1 << st0[3:0]; 118 | 4'b1110: _st0 = {rsp, 3'b000, dsp}; 119 | 4'b1111: _st0 = {16{(st1 < st0)}}; 120 | default: _st0 = 16'hxxxx; 121 | endcase 122 | end 123 | 124 | wire is_alu = (insn[15:13] == 3'b011); 125 | wire is_lit = (insn[15]); 126 | 127 | assign io_rd = (is_alu & (insn[11:8] == 4'hc)); 128 | assign io_wr = _ramWE; 129 | assign io_addr = st0; 130 | assign io_dout = st1; 131 | 132 | assign _ramWE = is_alu & insn[5]; 133 | assign _dstkW = is_lit | (is_alu & insn[7]); 134 | 135 | wire [1:0] dd = insn[1:0]; // D stack delta 136 | wire [1:0] rd = insn[3:2]; // R stack delta 137 | 138 | always @* 139 | begin 140 | if (is_lit) begin // literal 141 | _dsp = dsp + 1; 142 | _rsp = rsp; 143 | _rstkW = 0; 144 | _rstkD = _pc; 145 | end else if (is_alu) begin 146 | _dsp = dsp + {dd[1], dd[1], dd[1], dd}; 147 | _rsp = rsp + {rd[1], rd[1], rd[1], rd}; 148 | _rstkW = insn[6]; 149 | _rstkD = st0; 150 | end else begin // jump/call 151 | // predicated jump is like DROP 152 | if (insn[15:13] == 3'b001) begin 153 | _dsp = dsp - 1; 154 | end else begin 155 | _dsp = dsp; 156 | end 157 | if (insn[15:13] == 3'b010) begin // call 158 | _rsp = rsp + 1; 159 | _rstkW = 1; 160 | _rstkD = {pc_plus_1[14:0], 1'b0}; 161 | end else begin 162 | _rsp = rsp; 163 | _rstkW = 0; 164 | _rstkD = _pc; 165 | end 166 | end 167 | end 168 | 169 | always @* 170 | begin 171 | if (sys_rst_i) 172 | _pc = pc; 173 | else 174 | if ((insn[15:13] == 3'b000) | 175 | ((insn[15:13] == 3'b001) & (|st0 == 0)) | 176 | (insn[15:13] == 3'b010)) 177 | _pc = insn[12:0]; 178 | else if (is_alu & insn[12]) 179 | _pc = rst0[15:1]; 180 | else 181 | _pc = pc_plus_1; 182 | end 183 | 184 | always @(posedge sys_clk_i) 185 | begin 186 | if (sys_rst_i) begin 187 | pc <= 0; 188 | dsp <= 0; 189 | st0 <= 0; 190 | rsp <= 0; 191 | end else begin 192 | dsp <= _dsp; 193 | pc <= _pc; 194 | st0 <= _st0; 195 | rsp <= _rsp; 196 | end 197 | end 198 | 199 | endmodule // j1 200 | -------------------------------------------------------------------------------- /fpga/src/miniuart.vhd: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Title : MINIUART2 -- this is a modified version without Wishbone interface 3 | -- Project : MINIUART2 4 | ------------------------------------------------------------------------------- 5 | -- File : MiniUart.vhd 6 | -- Author : Philippe CARTON 7 | -- (philippe.carton2@libertysurf.fr) 8 | -- Organization: 9 | -- Created : 15/12/2001 10 | -- Last update : 8/1/2003 11 | -- Platform : Foundation 3.1i 12 | -- Simulators : ModelSim 5.5b 13 | -- Synthesizers: Xilinx Synthesis 14 | -- Targets : Xilinx Spartan 15 | -- Dependency : IEEE std_logic_1164, Rxunit.vhd, Txunit.vhd, utils.vhd 16 | ------------------------------------------------------------------------------- 17 | -- Description: Uart (Universal Asynchronous Receiver Transmitter) for SoC. 18 | -- Wishbone compatable. 19 | ------------------------------------------------------------------------------- 20 | -- Copyright (c) notice 21 | -- This core adheres to the GNU public license 22 | -- 23 | ------------------------------------------------------------------------------- 24 | -- Revisions : 25 | -- Revision Number : 26 | -- Version : 27 | -- Date : 28 | -- Modifier : name 29 | -- Description : 30 | -- 31 | ------------------------------------------------------------------------------- 32 | -- Revision History: 33 | -- 2014-12-19: removed wishbone interface (uh@xlerb.de) 34 | 35 | 36 | library ieee; 37 | use ieee.std_logic_1164.all; 38 | 39 | entity MINIUART2 is 40 | generic(BRDIVISOR: INTEGER range 0 to 65535 := 143); -- Baud rate divisor 143 = 115200 at 66 Mhz 41 | port ( 42 | clk: in STD_LOGIC; 43 | rst: in STD_LOGIC; 44 | rx: in STD_LOGIC; 45 | tx: out STD_LOGIC; 46 | io_rd: in STD_LOGIC; 47 | io_wr: in STD_LOGIC; 48 | io_addr: in STD_LOGIC; 49 | io_din: in STD_LOGIC_VECTOR (15 downto 0); 50 | io_dout: out STD_LOGIC_VECTOR (15 downto 0)); 51 | end MINIUART2; 52 | 53 | -- Architecture for UART for synthesis 54 | architecture Behaviour of MINIUART2 is 55 | 56 | component Counter 57 | generic(COUNT: INTEGER range 0 to 65535); -- Count revolution 58 | port ( 59 | Clk : in std_logic; -- Clock 60 | Reset : in std_logic; -- Reset input 61 | CE : in std_logic; -- Chip Enable 62 | O : out std_logic); -- Output 63 | end component; 64 | 65 | component RxUnit 66 | port ( 67 | Clk : in std_logic; -- system clock signal 68 | Reset : in std_logic; -- Reset input 69 | Enable : in std_logic; -- Enable input 70 | ReadA : in Std_logic; -- Async Read Received Byte 71 | RxD : in std_logic; -- RS-232 data input 72 | RxAv : out std_logic; -- Byte available 73 | DataO : out std_logic_vector(7 downto 0)); -- Byte received 74 | end component; 75 | 76 | component TxUnit 77 | port ( 78 | Clk : in std_logic; -- Clock signal 79 | Reset : in std_logic; -- Reset input 80 | Enable : in std_logic; -- Enable input 81 | LoadA : in std_logic; -- Asynchronous Load 82 | TxD : out std_logic; -- RS-232 data output 83 | Busy : out std_logic; -- Tx Busy 84 | DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit 85 | end component; 86 | 87 | signal RxData : std_logic_vector(7 downto 0); -- Last Byte received 88 | signal TxData : std_logic_vector(7 downto 0); -- Last bytes transmitted 89 | signal SReg : std_logic_vector(7 downto 0); -- Status register 90 | signal EnabRx : std_logic; -- Enable RX unit 91 | signal EnabTx : std_logic; -- Enable TX unit 92 | signal RxAv : std_logic; -- Data Received 93 | signal TxBusy : std_logic; -- Transmiter Busy 94 | signal ReadA : std_logic; -- Async Read receive buffer 95 | signal LoadA : std_logic; -- Async Load transmit buffer 96 | signal Sig0 : std_logic; -- gnd signal 97 | signal Sig1 : std_logic; -- vcc signal 98 | 99 | 100 | begin 101 | sig0 <= '0'; 102 | sig1 <= '1'; 103 | Uart_Rxrate : Counter -- Baud Rate adjust 104 | generic map (COUNT => BRDIVISOR) 105 | port map (clk, rst, sig1, EnabRx); 106 | Uart_Txrate : Counter -- 4 Divider for Tx 107 | generic map (COUNT => 4) 108 | port map (clk, rst, EnabRx, EnabTx); 109 | Uart_TxUnit : TxUnit port map (clk, rst, EnabTX, LoadA, tx, TxBusy, TxData); 110 | Uart_RxUnit : RxUnit port map (clk, rst, EnabRX, ReadA, rx, RxAv, RxData); 111 | 112 | -- status register 113 | SReg(0) <= RxAv; 114 | SReg(1) <= TxBusy; 115 | SReg(7 downto 2) <= (others => '0'); -- the rest is silence 116 | 117 | process (clk, rst, io_addr, io_wr, io_din) 118 | begin 119 | if Rising_Edge(clk) then 120 | if rst='1' then 121 | LoadA <= '0'; 122 | elsif io_wr='1' and io_addr='0' then -- write byte to tx 123 | TxData <= io_din(7 downto 0); 124 | LoadA <= '1'; 125 | else 126 | LoadA <= '0'; 127 | end if; 128 | end if; 129 | end process; 130 | 131 | process (clk, rst, io_addr, io_rd, RxData, TxBusy, RxAv) 132 | begin 133 | if Rising_Edge(clk) then 134 | if rst='1' then 135 | ReadA <= '0'; 136 | elsif io_rd='1' and io_addr='0' then 137 | ReadA <= '1'; 138 | else 139 | ReadA <= '0'; 140 | end if; 141 | end if; 142 | end process; 143 | io_dout(7 downto 0) <= RxData when io_addr='0' else SReg; 144 | io_dout(15 downto 8) <= (others => '0'); 145 | 146 | end Behaviour; 147 | -------------------------------------------------------------------------------- /fpga/src/papilio-pro-j1.vhd: -------------------------------------------------------------------------------- 1 | library IEEE; 2 | use IEEE.STD_LOGIC_1164.ALL; 3 | use IEEE.NUMERIC_STD.ALL; 4 | 5 | entity papilio_pro_j1 is 6 | port ( 7 | clk_in: in std_logic; 8 | rx: in std_logic; 9 | tx: out std_logic; 10 | wing: out std_logic_vector(15 downto 0)); 11 | end papilio_pro_j1; 12 | 13 | architecture Behavioral of papilio_pro_j1 is 14 | 15 | component clock is 16 | port ( 17 | clk_in: in std_logic; 18 | clk: out std_logic; 19 | clk180: out std_logic); 20 | end component; 21 | 22 | component j1 is 23 | port ( 24 | sys_clk_i: in std_logic; 25 | sys_rst_i: in std_logic; 26 | io_rd: out std_logic; 27 | io_wr: out std_logic; 28 | io_addr: out std_logic_vector (15 downto 0); 29 | io_din: in std_logic_vector (15 downto 0); 30 | io_dout: out std_logic_vector (15 downto 0)); 31 | end component; 32 | 33 | component miniuart2 is 34 | port ( 35 | clk: in STD_LOGIC; 36 | rst: in STD_LOGIC; 37 | rx: in STD_LOGIC; 38 | tx: out STD_LOGIC; 39 | io_rd: in STD_LOGIC; 40 | io_wr: in STD_LOGIC; 41 | io_addr: in STD_LOGIC; 42 | io_din: in STD_LOGIC_VECTOR (15 downto 0); 43 | io_dout: out STD_LOGIC_VECTOR (15 downto 0)); 44 | end component; 45 | 46 | 47 | signal clk: std_logic; 48 | signal clk180: std_logic; 49 | 50 | signal rst_counter: integer range 0 to 15 := 15; 51 | signal sys_rst: std_logic := '1'; 52 | 53 | signal io_rd: std_logic; 54 | signal io_wr: std_logic; 55 | signal io_addr: std_logic_vector (15 downto 0); 56 | signal io_din: std_logic_vector (15 downto 0); 57 | signal io_dout: std_logic_vector (15 downto 0); 58 | 59 | signal uart_en: std_logic; 60 | signal uart_rd: std_logic; 61 | signal uart_wr: std_logic; 62 | signal uart_dout: std_logic_vector (15 downto 0); 63 | begin 64 | 65 | clock_inst: clock 66 | port map ( 67 | clk_in => clk_in, 68 | clk => clk, 69 | clk180 => clk180); 70 | 71 | j1_inst: j1 72 | port map ( 73 | sys_clk_i => clk, 74 | sys_rst_i => sys_rst, 75 | io_rd => io_rd, 76 | io_wr => io_wr, 77 | io_addr => io_addr, 78 | io_din => io_din, 79 | io_dout => io_dout); 80 | 81 | uart_inst: miniuart2 82 | port map( 83 | clk => clk180, 84 | rst => sys_rst, 85 | rx => rx, 86 | tx => tx, 87 | io_rd => uart_rd, 88 | io_wr => uart_wr, 89 | io_addr => io_addr(0), 90 | io_din => io_dout, 91 | io_dout => uart_dout); 92 | 93 | process (clk, rst_counter) 94 | begin 95 | if rising_edge(clk) and rst_counter>0 then 96 | rst_counter <= rst_counter-1; 97 | end if; 98 | end process; 99 | sys_rst <= '1' when rst_counter>0 else '0'; 100 | 101 | uart_en <= '1' when io_addr(15 downto 1)="111100000000000" else '0'; 102 | uart_rd <= io_rd and uart_en; 103 | uart_wr <= io_wr and uart_en; 104 | 105 | process (io_addr, uart_dout) 106 | begin 107 | case io_addr(15 downto 1) is 108 | when "111100000000000" => 109 | io_din <= uart_dout; 110 | when others => 111 | io_din <= (others=>'0'); 112 | end case; 113 | end process; 114 | 115 | wing <= (others=>'0'); 116 | 117 | end Behavioral; -------------------------------------------------------------------------------- /fpga/src/papilio-pro.ucf: -------------------------------------------------------------------------------- 1 | # UCF file for the Papilio Pro board 2 | # Generated by pin_converter, written by Kevin Lindsey 3 | # https://github.com/thelonious/papilio_pins/tree/development/pin_converter 4 | 5 | # Main board wing pin [] to FPGA pin Pxx map 6 | # -------C------- -------B------- -------A------- 7 | # [GND] [C00] P114 [GND] [B00] P99 P100 [A15] 8 | # [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] 9 | # [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] 10 | # [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] 11 | # [C04] P118 [B04] P84 P85 [A11] [5V0] 12 | # [C05] P119 [B05] P82 P83 [A10] [3V3] 13 | # [C06] P120 [B06] P80 P81 [A09] [2V5] 14 | # [C07] P121 [B07] P78 P79 [A08] [GND] 15 | # [GND] [C08] P123 [GND] [B08] P74 P75 [A07] 16 | # [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] 17 | # [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] 18 | # [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] 19 | # [C12] P131 [B12] P57 P58 [A03] [5V0] 20 | # [C13] P132 [B13] P55 P56 [A02] [3V3] 21 | # [C14] P133 [B14] P50 P51 [A01] [2V5] 22 | # [C15] P134 [B15] P47 P48 [A00] [GND] 23 | 24 | ## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. 25 | CONFIG PROHIBIT=P144; 26 | CONFIG PROHIBIT=P69; 27 | CONFIG PROHIBIT=P60; 28 | 29 | NET CLK_IN LOC="P94" | IOSTANDARD=LVTTL | PERIOD=31.25ns; # CLK 30 | NET RX LOC="P101" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # RX 31 | NET TX LOC="P105" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # TX 32 | NET WING(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 33 | NET WING(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 34 | NET WING(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 35 | NET WING(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 36 | NET WING(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 37 | NET WING(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 38 | NET WING(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 39 | NET WING(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 40 | NET WING(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 41 | NET WING(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 42 | NET WING(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 43 | NET WING(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 44 | NET WING(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 45 | NET WING(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 46 | NET WING(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 47 | NET WING(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 48 | #NET A(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 49 | #NET A(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 50 | #NET A(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 51 | #NET A(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 52 | #NET A(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 53 | #NET A(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 54 | #NET A(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 55 | #NET A(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 56 | #NET A(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 57 | #NET A(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 58 | #NET A(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 59 | #NET A(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 60 | #NET A(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 61 | #NET A(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 62 | #NET A(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 63 | #NET A(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 64 | #NET B(0) LOC="P99" | IOSTANDARD=LVTTL; # B0 65 | #NET B(1) LOC="P97" | IOSTANDARD=LVTTL; # B1 66 | #NET B(2) LOC="P92" | IOSTANDARD=LVTTL; # B2 67 | #NET B(3) LOC="P87" | IOSTANDARD=LVTTL; # B3 68 | #NET B(4) LOC="P84" | IOSTANDARD=LVTTL; # B4 69 | #NET B(5) LOC="P82" | IOSTANDARD=LVTTL; # B5 70 | #NET B(6) LOC="P80" | IOSTANDARD=LVTTL; # B6 71 | #NET B(7) LOC="P78" | IOSTANDARD=LVTTL; # B7 72 | #NET B(8) LOC="P74" | IOSTANDARD=LVTTL; # B8 73 | #NET B(9) LOC="P95" | IOSTANDARD=LVTTL; # B9 74 | #NET B(10) LOC="P62" | IOSTANDARD=LVTTL; # B10 75 | #NET B(11) LOC="P59" | IOSTANDARD=LVTTL; # B11 76 | #NET B(12) LOC="P57" | IOSTANDARD=LVTTL; # B12 77 | #NET B(13) LOC="P55" | IOSTANDARD=LVTTL; # B13 78 | #NET B(14) LOC="P50" | IOSTANDARD=LVTTL; # B14 79 | #NET B(15) LOC="P47" | IOSTANDARD=LVTTL; # B15 80 | #NET C(0) LOC="P114" | IOSTANDARD=LVTTL; # C0 81 | #NET C(1) LOC="P115" | IOSTANDARD=LVTTL; # C1 82 | #NET C(2) LOC="P116" | IOSTANDARD=LVTTL; # C2 83 | #NET C(3) LOC="P117" | IOSTANDARD=LVTTL; # C3 84 | #NET C(4) LOC="P118" | IOSTANDARD=LVTTL; # C4 85 | #NET C(5) LOC="P119" | IOSTANDARD=LVTTL; # C5 86 | #NET C(6) LOC="P120" | IOSTANDARD=LVTTL; # C6 87 | #NET C(7) LOC="P121" | IOSTANDARD=LVTTL; # C7 88 | #NET C(8) LOC="P123" | IOSTANDARD=LVTTL; # C8 89 | #NET C(9) LOC="P124" | IOSTANDARD=LVTTL; # C9 90 | #NET C(10) LOC="P126" | IOSTANDARD=LVTTL; # C10 91 | #NET C(11) LOC="P127" | IOSTANDARD=LVTTL; # C11 92 | #NET C(12) LOC="P131" | IOSTANDARD=LVTTL; # C12 93 | #NET C(13) LOC="P132" | IOSTANDARD=LVTTL; # C13 94 | #NET C(14) LOC="P133" | IOSTANDARD=LVTTL; # C14 95 | #NET C(15) LOC="P134" | IOSTANDARD=LVTTL; # C15 96 | #NET SDRAM_ADDR(0) LOC="P140" | IOSTANDARD=LVTTL; # SDRAM_ADDR0 97 | #NET SDRAM_ADDR(1) LOC="P139" | IOSTANDARD=LVTTL; # SDRAM_ADDR1 98 | #NET SDRAM_ADDR(2) LOC="P138" | IOSTANDARD=LVTTL; # SDRAM_ADDR2 99 | #NET SDRAM_ADDR(3) LOC="P137" | IOSTANDARD=LVTTL; # SDRAM_ADDR3 100 | #NET SDRAM_ADDR(4) LOC="P46" | IOSTANDARD=LVTTL; # SDRAM_ADDR4 101 | #NET SDRAM_ADDR(5) LOC="P45" | IOSTANDARD=LVTTL; # SDRAM_ADDR5 102 | #NET SDRAM_ADDR(6) LOC="P44" | IOSTANDARD=LVTTL; # SDRAM_ADDR6 103 | #NET SDRAM_ADDR(7) LOC="P43" | IOSTANDARD=LVTTL; # SDRAM_ADDR7 104 | #NET SDRAM_ADDR(8) LOC="P41" | IOSTANDARD=LVTTL; # SDRAM_ADDR8 105 | #NET SDRAM_ADDR(9) LOC="P40" | IOSTANDARD=LVTTL; # SDRAM_ADDR9 106 | #NET SDRAM_ADDR(10) LOC="P141" | IOSTANDARD=LVTTL; # SDRAM_ADDR10 107 | #NET SDRAM_ADDR(11) LOC="P35" | IOSTANDARD=LVTTL; # SDRAM_ADDR11 108 | #NET SDRAM_ADDR(12) LOC="P34" | IOSTANDARD=LVTTL; # SDRAM_ADDR12 109 | #NET SDRAM_DATA(0) LOC="P9" | IOSTANDARD=LVTTL; # SDRAM_DATA0 110 | #NET SDRAM_DATA(1) LOC="P10" | IOSTANDARD=LVTTL; # SDRAM_DATA1 111 | #NET SDRAM_DATA(2) LOC="P11" | IOSTANDARD=LVTTL; # SDRAM_DATA2 112 | #NET SDRAM_DATA(3) LOC="P12" | IOSTANDARD=LVTTL; # SDRAM_DATA3 113 | #NET SDRAM_DATA(4) LOC="P14" | IOSTANDARD=LVTTL; # SDRAM_DATA4 114 | #NET SDRAM_DATA(5) LOC="P15" | IOSTANDARD=LVTTL; # SDRAM_DATA5 115 | #NET SDRAM_DATA(6) LOC="P16" | IOSTANDARD=LVTTL; # SDRAM_DATA6 116 | #NET SDRAM_DATA(7) LOC="P8" | IOSTANDARD=LVTTL; # SDRAM_DATA7 117 | #NET SDRAM_DATA(8) LOC="P21" | IOSTANDARD=LVTTL; # SDRAM_DATA8 118 | #NET SDRAM_DATA(9) LOC="P22" | IOSTANDARD=LVTTL; # SDRAM_DATA9 119 | #NET SDRAM_DATA(10) LOC="P23" | IOSTANDARD=LVTTL; # SDRAM_DATA10 120 | #NET SDRAM_DATA(11) LOC="P24" | IOSTANDARD=LVTTL; # SDRAM_DATA11 121 | #NET SDRAM_DATA(12) LOC="P26" | IOSTANDARD=LVTTL; # SDRAM_DATA12 122 | #NET SDRAM_DATA(13) LOC="P27" | IOSTANDARD=LVTTL; # SDRAM_DATA13 123 | #NET SDRAM_DATA(14) LOC="P29" | IOSTANDARD=LVTTL; # SDRAM_DATA14 124 | #NET SDRAM_DATA(15) LOC="P30" | IOSTANDARD=LVTTL; # SDRAM_DATA15 125 | #NET SDRAM_DQML LOC="P7" | IOSTANDARD=LVTTL; # SDRAM_DQML 126 | #NET SDRAM_DQMH LOC="P17" | IOSTANDARD=LVTTL; # SDRAM_DQMH 127 | #NET SDRAM_BA(0) LOC="P143" | IOSTANDARD=LVTTL; # SDRAM_BA0 128 | #NET SDRAM_BA(1) LOC="P142" | IOSTANDARD=LVTTL; # SDRAM_BA1 129 | #NET SDRAM_nWE LOC="P6" | IOSTANDARD=LVTTL; # SDRAM_nWE 130 | #NET SDRAM_nCAS LOC="P5" | IOSTANDARD=LVTTL; # SDRAM_nCAS 131 | #NET SDRAM_nRAS LOC="P2" | IOSTANDARD=LVTTL; # SDRAM_nRAS 132 | #NET SDRAM_CS LOC="P1" | IOSTANDARD=LVTTL; # SDRAM_CS 133 | #NET SDRAM_CLK LOC="P32" | IOSTANDARD=LVTTL; # SDRAM_CLK 134 | #NET SDRAM_CKE LOC="P33" | IOSTANDARD=LVTTL; # SDRAM_CKE 135 | #NET LED1 LOC="P112" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # LED1 136 | #NET JTAG_TMS LOC="P107" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TMS 137 | #NET JTAG_TCK LOC="P109" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TCK 138 | #NET JTAG_TDI LOC="P110" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDI 139 | #NET JTAG_TDO LOC="P106" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDO 140 | #NET FLASH_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS 141 | #NET FLASH_CK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK 142 | #NET FLASH_SI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI 143 | #NET FLASH_SO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST | PULLUP; # FLASH_SO 144 | -------------------------------------------------------------------------------- /fpga/src/utils.vhd: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Title : UART 3 | -- Project : UART 4 | ------------------------------------------------------------------------------- 5 | -- File : utils.vhd 6 | -- Author : Philippe CARTON 7 | -- (philippe.carton2@libertysurf.fr) 8 | -- Organization: 9 | -- Created : 15/12/2001 10 | -- Last update : 8/1/2003 11 | -- Platform : Foundation 3.1i 12 | -- Simulators : ModelSim 5.5b 13 | -- Synthesizers: Xilinx Synthesis 14 | -- Targets : Xilinx Spartan 15 | -- Dependency : IEEE std_logic_1164 16 | ------------------------------------------------------------------------------- 17 | -- Description: VHDL utility file 18 | ------------------------------------------------------------------------------- 19 | -- Copyright (c) notice 20 | -- This core adheres to the GNU public license 21 | -- 22 | ------------------------------------------------------------------------------- 23 | -- Revisions : 24 | -- Revision Number : 25 | -- Version : 26 | -- Date : 27 | -- Modifier : name 28 | -- Description : 29 | -- 30 | ------------------------------------------------------------------------------ 31 | 32 | 33 | ------------------------------------------------------------------------------- 34 | -- Revision list 35 | -- Version Author Date Changes 36 | -- 37 | -- 1.0 Philippe CARTON 19 December 2001 New model 38 | -- philippe.carton2@libertysurf.fr 39 | ------------------------------------------------------------------------------- 40 | 41 | -------------------------------------------------------------------------------- 42 | -- Synchroniser: 43 | -- Synchronize an input signal (C1) with an input clock (C). 44 | -- The result is the O signal which is synchronous of C, and persist for 45 | -- one C clock period. 46 | -------------------------------------------------------------------------------- 47 | library IEEE,STD; 48 | use IEEE.std_logic_1164.all; 49 | 50 | entity synchroniser is 51 | port ( 52 | C1 : in std_logic;-- Asynchronous signal 53 | C : in std_logic;-- Clock 54 | O : out std_logic);-- Synchronised signal 55 | end synchroniser; 56 | 57 | architecture Behaviour of synchroniser is 58 | signal C1A : std_logic; 59 | signal C1S : std_logic; 60 | signal R : std_logic; 61 | begin 62 | RiseC1A : process(C1,R) 63 | begin 64 | if Rising_Edge(C1) then 65 | C1A <= '1'; 66 | end if; 67 | if (R = '1') then 68 | C1A <= '0'; 69 | end if; 70 | end process; 71 | 72 | SyncP : process(C,R) 73 | begin 74 | if Rising_Edge(C) then 75 | if (C1A = '1') then 76 | C1S <= '1'; 77 | else C1S <= '0'; 78 | end if; 79 | if (C1S = '1') then 80 | R <= '1'; 81 | else R <= '0'; 82 | end if; 83 | end if; 84 | if (R = '1') then 85 | C1S <= '0'; 86 | end if; 87 | end process; 88 | O <= C1S; 89 | end Behaviour; 90 | 91 | ------------------------------------------------------------------------------- 92 | -- Counter 93 | -- This counter is a parametrizable clock divider. 94 | -- The count value is the generic parameter Count. 95 | -- It is CE enabled. (it will count only if CE is high). 96 | -- When it overflow, it will emit a pulse on O. 97 | -- It can be reseted to 0. 98 | ------------------------------------------------------------------------------- 99 | library IEEE,STD; 100 | use IEEE.std_logic_1164.all; 101 | 102 | entity Counter is 103 | generic(Count: INTEGER range 0 to 65535); -- Count revolution 104 | port ( 105 | Clk : in std_logic; -- Clock 106 | Reset : in std_logic; -- Reset input 107 | CE : in std_logic; -- Chip Enable 108 | O : out std_logic); -- Output 109 | end Counter; 110 | 111 | architecture Behaviour of Counter is 112 | begin 113 | counter : process(Clk,Reset) 114 | variable Cnt : INTEGER range 0 to Count-1; 115 | begin 116 | if Reset = '1' then 117 | Cnt := Count - 1; 118 | O <= '0'; 119 | elsif Rising_Edge(Clk) then 120 | if CE = '1' then 121 | if Cnt = 0 then 122 | O <= '1'; 123 | Cnt := Count - 1; 124 | else 125 | O <= '0'; 126 | Cnt := Cnt - 1; 127 | end if; 128 | else O <= '0'; 129 | end if; 130 | end if; 131 | end process; 132 | end Behaviour; 133 | -------------------------------------------------------------------------------- /fpga/test/miniuart2_tb.vhd: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Company: 3 | -- Engineer: 4 | -- 5 | -- Create Date: 11:48:15 12/20/2014 6 | -- Design Name: 7 | -- Module Name: /mnt/hgfs/Projects/j1eforth/vhdl/test/miniuart2_tb.vhd 8 | -- Project Name: papilio-pro-forth 9 | -- Target Device: 10 | -- Tool versions: 11 | -- Description: 12 | -- 13 | -- VHDL Test Bench Created by ISE for module: MINIUART2 14 | -- 15 | -- Dependencies: 16 | -- 17 | -- Revision: 18 | -- Revision 0.01 - File Created 19 | -- Additional Comments: 20 | -- 21 | -- Notes: 22 | -- This testbench has been automatically generated using types std_logic and 23 | -- std_logic_vector for the ports of the unit under test. Xilinx recommends 24 | -- that these types always be used for the top-level I/O of a design in order 25 | -- to guarantee that the testbench will bind correctly to the post-implementation 26 | -- simulation model. 27 | -------------------------------------------------------------------------------- 28 | LIBRARY ieee; 29 | USE ieee.std_logic_1164.ALL; 30 | 31 | -- Uncomment the following library declaration if using 32 | -- arithmetic functions with Signed or Unsigned values 33 | --USE ieee.numeric_std.ALL; 34 | 35 | ENTITY miniuart2_tb IS 36 | END miniuart2_tb; 37 | 38 | ARCHITECTURE behavior OF miniuart2_tb IS 39 | 40 | -- Component Declaration for the Unit Under Test (UUT) 41 | 42 | COMPONENT MINIUART2 43 | PORT( 44 | clk : IN std_logic; 45 | rst : IN std_logic; 46 | rx : IN std_logic; 47 | tx : OUT std_logic; 48 | io_rd : IN std_logic; 49 | io_wr : IN std_logic; 50 | io_addr : IN std_logic; 51 | io_din : IN std_logic_vector(15 downto 0); 52 | io_dout : OUT std_logic_vector(15 downto 0) 53 | ); 54 | END COMPONENT; 55 | 56 | 57 | --Inputs 58 | signal clk : std_logic := '0'; 59 | signal rst : std_logic := '0'; 60 | signal rx : std_logic := '0'; 61 | signal io_rd : std_logic := '0'; 62 | signal io_wr : std_logic := '0'; 63 | signal io_addr : std_logic := '0'; 64 | signal io_din : std_logic_vector(15 downto 0) := (others => '0'); 65 | 66 | --Outputs 67 | signal tx : std_logic; 68 | signal io_dout : std_logic_vector(15 downto 0); 69 | 70 | -- Clock period definitions 71 | constant clk_period : time := 10 ns; -- 31.25 ns; 72 | 73 | BEGIN 74 | 75 | -- Instantiate the Unit Under Test (UUT) 76 | uut: MINIUART2 PORT MAP ( 77 | clk => clk, 78 | rst => rst, 79 | rx => rx, 80 | tx => tx, 81 | io_rd => io_rd, 82 | io_wr => io_wr, 83 | io_addr => io_addr, 84 | io_din => io_din, 85 | io_dout => io_dout 86 | ); 87 | 88 | -- Clock process definitions 89 | clk_process :process 90 | begin 91 | clk <= '0'; 92 | wait for clk_period/2; 93 | clk <= '1'; 94 | wait for clk_period/2; 95 | end process; 96 | 97 | 98 | -- Stimulus process 99 | stim_proc: process 100 | begin 101 | -- hold reset state for 100 ns. 102 | wait for 100 ns; 103 | 104 | wait for clk_period*5; 105 | 106 | rst <= '1'; 107 | 108 | wait for clk_period*3; 109 | 110 | rst <= '0'; 111 | 112 | wait for clk_period*3; 113 | 114 | -- insert stimulus here 115 | io_din <= X"002A"; 116 | io_addr <= '1'; 117 | io_wr <= '1'; 118 | 119 | wait for clk_period; 120 | 121 | io_addr <= '0'; 122 | io_din <= X"0000"; 123 | io_wr <= '0'; 124 | 125 | wait; 126 | end process; 127 | 128 | END; 129 | -------------------------------------------------------------------------------- /fpga/test/papilio_pro_j1_tb.vhd: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Company: 3 | -- Engineer: 4 | -- 5 | -- Create Date: 22:12:23 03/03/2012 6 | -- Design Name: 7 | -- Module Name: /home/ben/prog/PapilioForth/ise/main_tb.vhd 8 | -- Project Name: PapilioForth 9 | -- Target Device: 10 | -- Tool versions: 11 | -- Description: 12 | -- 13 | -- VHDL Test Bench Created by ISE for module: main 14 | -- 15 | -- Dependencies: 16 | -- 17 | -- Revision: 18 | -- Revision 0.01 - File Created 19 | -- Additional Comments: 20 | -- 21 | -- Notes: 22 | -- This testbench has been automatically generated using types std_logic and 23 | -- std_logic_vector for the ports of the unit under test. Xilinx recommends 24 | -- that these types always be used for the top-level I/O of a design in order 25 | -- to guarantee that the testbench will bind correctly to the post-implementation 26 | -- simulation model. 27 | -------------------------------------------------------------------------------- 28 | LIBRARY ieee; 29 | USE ieee.std_logic_1164.ALL; 30 | 31 | -- Uncomment the following library declaration if using 32 | -- arithmetic functions with Signed or Unsigned values 33 | --USE ieee.numeric_std.ALL; 34 | 35 | ENTITY papilio_pro_j1_tb IS 36 | END papilio_pro_j1_tb; 37 | 38 | ARCHITECTURE behavior OF papilio_pro_j1_tb IS 39 | 40 | -- Component Declaration for the Unit Under Test (UUT) 41 | 42 | COMPONENT papilio_pro_j1 43 | PORT( 44 | clk_in : IN std_logic; 45 | rx : IN std_logic; 46 | tx : OUT std_logic; 47 | wing : INOUT std_logic_vector(15 downto 0) 48 | ); 49 | END COMPONENT; 50 | 51 | 52 | --Inputs 53 | signal clk_in : std_logic := '0'; 54 | signal rx : std_logic := '0'; 55 | 56 | --Outputs 57 | signal tx : std_logic; 58 | signal wing : std_logic_vector(15 downto 0); 59 | 60 | -- Clock period definitions 61 | constant clk_in_period : time := 31.25 ns; 62 | 63 | BEGIN 64 | 65 | -- Instantiate the Unit Under Test (UUT) 66 | uut: papilio_pro_j1 PORT MAP ( 67 | clk_in => clk_in, 68 | rx => rx, 69 | tx => tx, 70 | wing => wing 71 | ); 72 | 73 | -- Clock process definitions 74 | clk_in_process :process 75 | begin 76 | clk_in <= '0'; 77 | wait for clk_in_period/2; 78 | clk_in <= '1'; 79 | wait for clk_in_period/2; 80 | end process; 81 | 82 | 83 | -- Stimulus process 84 | stim_proc: process 85 | begin 86 | -- hold reset state for 100 ns. 87 | wait for 100 ns; 88 | 89 | wait for clk_in_period*50; 90 | 91 | -- insert stimulus here 92 | 93 | wait; 94 | end process; 95 | 96 | END; 97 | -------------------------------------------------------------------------------- /ipv4.4th: -------------------------------------------------------------------------------- 1 | ( 2 | I feel that the Kernel is at it's best for now and that I can proceed 3 | to do some other things. Note that version 1 is just to make the whole 4 | thing work, later on I might look at optimisation where I might have to move 5 | some stuff around so that memory utilization and execution speed efficiency is 6 | achieved.So far the Kernel works without needing tweaks. 7 | 8 | Work in progress: Implementing simple ipv4 for the j1eforth model 9 | 10 | 7 project targets: 11 | 12 | 1. Add multi-tasking support to the Kernel - 0% 13 | 2. Modify j1 sim to use pcap interface for network tx and rx - 0% 14 | 3. ARP - 0% 15 | 4. ICMP - 0% 16 | 5. IP - 0% 17 | 6. UDP - 0% 18 | 7. TCP - 0% 19 | 20 | Hopefully I will get time to do all this and also document the design of 21 | the j1eforth Kernel for those who are starting out with forth and also those 22 | who wish to tinker with the Kernel for fun. 23 | ) 24 | 25 | hex 26 | 27 | forth-wordlist >voc forth 28 | 29 | vocabulary ipv4.1 30 | only forth also ipv4.1 31 | 32 | ipv4.1 definitions 33 | 34 | variable active_struct 35 | 36 | : field 37 | create over , + 38 | does> 39 | @ active_struct @ + ; 40 | 41 | ( ethernet frame ) 42 | 43 | 0 44 | 6 field eth_dest ( 48 bit source address ) 45 | 6 field eth_src ( 48 bit destination address ) 46 | 2 field eth_type ( 16 bit type ) 47 | constant eth_frame% 48 | 49 | ( arp message ) 50 | 51 | 0 52 | 2 field arp_hw ( 16 bit hw type ) 53 | 2 field arp_proto ( 16 bit protocol ) 54 | 1 field arp_hlen ( 8 bit hw address length ) 55 | 1 field arp_plen ( 8 bit protocol address length ) 56 | 2 field arp_op ( 16 bit operation ) 57 | 6 field arp_shw ( 48 bit sender hw address ) 58 | 4 field arp_sp ( 32 bit sender ipv4 address ) 59 | 6 field arp_thw ( 48 bit target hw address ) 60 | 4 field arp_tp ( 32 bit target ipv4 address ) 61 | constant arp_message% 62 | 63 | ( arp cache ) 64 | 65 | 0 66 | 4 field ac_ip ( 32 bit protocol address ) 67 | 6 field ac_hw ( 48 bit hw address ) 68 | constant arp_cache% 69 | 70 | ( ipv4 datagram header ) 71 | 72 | 0 73 | 1 field ip_vhl ( 4 bit version and 4 bit header length ) 74 | 1 field ip_tos ( 8 bit type of service ) 75 | 2 field ip_len ( 16 bit length ) 76 | 2 field ip_id ( 16 bit identification ) 77 | 2 field ip_frags ( 3 bit flags 13 bit fragment offset ) 78 | 1 field ip_ttl ( 8 bit time to live ) 79 | 1 field ip_proto ( 8 bit protocol number ) 80 | 2 field ip_checksum ( 16 bit checksum ) 81 | 4 field ip_source ( 32 bit source address ) 82 | 4 field ip_dest ( 32 bit destination address ) 83 | constant ip_header% 84 | 85 | ( icmp header ) 86 | 87 | 0 88 | 1 field icmp_type ( 8 bits type ) 89 | 1 field icmp_code ( 8 bits code ) 90 | 2 field icmp_checksum ( 16 bits checksum ) 91 | constant icmp_header% 92 | 93 | ( udp datagram ) 94 | 95 | 0 96 | 2 field udp_source ( 16 bit source port ) 97 | 2 field udp_dest ( 16 bit destination port ) 98 | 2 field udp_len ( 16 bit length ) 99 | 2 field udp_checksum ( 16 bit checksum ) 100 | constant udp_datagram% 101 | 102 | ( tcp header ) 103 | 104 | 0 105 | 2 field tcp_source ( 16 bit source port ) 106 | 2 field tcp_dest ( 16 bit destination port ) 107 | 4 field tcp_seq ( 32 bit sequence number ) 108 | 4 field tcp_ack ( 32 bit acknowledgement ) 109 | 1 field tcp_offset ( 8 bit offset ) 110 | 2 field tcp_flags ( 16 bit flags ) 111 | 1 field tcp_window ( 8 bit window size ) 112 | 2 field tcp_checksum ( 16 bit checksum ) 113 | 2 field tcp_urgent ( 16 bit urgent pointer ) 114 | constant tcp_header% 115 | 116 | 4000 constant eth_rx_buf 117 | 118 | : htons ( n -- n ) 119 | dup ff and 8 lshift swap ff00 and 8 rshift or ; 120 | 121 | create ip_addr a8c0 , fe0b , 122 | create ip_netmask ffff , 00ff , 123 | create hw_addr bd00 , 333b , 7f05 , 124 | 125 | 8 constant eth_ip_type 126 | 608 constant eth_arp_type 127 | 3580 constant eth_rarp_type 128 | 129 | 100 constant arp_request_type 130 | 200 constant arp_reply_type 131 | 132 | 0 constant icmp_echo_reply 133 | 8 constant icmp_echo 134 | 135 | 0 constant arp_action 136 | 137 | : arp_lookup 0 to arp_action ; 138 | : arp_update 1 to arp_action ; 139 | : arp_insert 2 to arp_action ; 140 | : arp_delete 3 to arp_action ; 141 | : +arp_age 4 to arp_action ; 142 | 143 | : (arp_lookup) cr ." compare" . . ; 144 | : (arp_update) cr ." update" . . ; 145 | : (arp_insert) cr ." insert" ; 146 | : (arp_delete) cr ." delete" ; 147 | : (+arp_age) cr ." age" ; 148 | 149 | : arp_table ( u -- ) 150 | create here over allot swap erase 151 | does> 152 | swap arp_cache% * + 153 | arp_action 0 to arp_action 154 | case 155 | 0 of (arp_lookup) endof 156 | 1 of (arp_update) endof 157 | 2 of (arp_insert) endof 158 | 3 of (arp_delete) endof 159 | 4 of (+arp_age) endof 160 | ." unknown cache option" 161 | endcase ; 162 | 163 | arp_cache% 8 * arp_table arp_cache 164 | 165 | : eth_rx f008 @ ; 166 | : eth_tx f008 ! ; 167 | 168 | : checksum ( address count -- checksum) 169 | over + 0 -rot 170 | do 171 | i @ + i @ over u> if 1+ then 172 | -2 +loop 173 | dup 10 rshift swap ffff and + 174 | dup 10 rshift + 175 | ffff xor ; 176 | : arp_in ( -- ) 177 | eth_frame% active_struct +! 178 | arp_op @ arp_request_type = if 179 | 100 arp_hw ! 180 | eth_ip_type arp_proto ! 181 | 6 arp_hlen c! 182 | 4 arp_plen c! 183 | arp_reply_type arp_op ! 184 | arp_shw arp_thw 6 cmove 185 | hw_addr arp_shw 6 cmove 186 | arp_sp arp_tp 4 cmove 187 | ip_addr arp_sp 4 cmove 188 | arp_thw 189 | eth_rx_buf active_struct ! 190 | eth_dest 6 cmove 191 | hw_addr eth_src 6 cmove 192 | eth_arp_type eth_type ! 193 | eth_tx 194 | else 195 | ( arp_update ) 196 | then ; 197 | : icmp_in 198 | ip_len @ htons 199 | ip_header% active_struct +! 200 | icmp_type c@ 8 = if 201 | 0 icmp_type c! 202 | icmp_checksum @ fff7 = if 203 | 9 icmp_checksum +! 204 | else 8 icmp_checksum +! then 205 | else 206 | cr ." weird icmp packet" 207 | then eth_tx ; 208 | : udp_in cr ." got udp packet." ; 209 | : tcp_in cr ." got tcp packet." ; 210 | : ip_in ( -- ) 211 | eth_frame% active_struct +! 212 | ip_vhl @ 45 = if 213 | ip_proto c@ case 214 | 1 of 215 | ip_source dup ip_dest 4 cmove 216 | ip_addr swap 4 cmove 217 | icmp_in 218 | endof 219 | 6 of tcp_in endof 220 | 17 of udp_in endof 221 | cr ." unknown ip protocol:" 222 | endcase 223 | else 224 | cr ." unsupported ip version detected" 225 | then ; 226 | : process ( -- ) 227 | eth_type @ case 228 | eth_arp_type of arp_in endof 229 | eth_ip_type of ip_in endof 230 | cr ." unknown ethernet protocol" 231 | endcase ; 232 | : pcap_poll 233 | eth_rx_buf active_struct ! 234 | active_struct @ 5dc erase 235 | eth_rx ; 236 | : round 237 | pcap_poll 0 <> if 238 | process 239 | then ; 240 | : main 241 | begin 242 | round 243 | again 244 | ; 245 | 246 | ( main ) 247 | 248 | forth definitions 249 | ipv4.1 definitions 250 | -------------------------------------------------------------------------------- /j1.4th: -------------------------------------------------------------------------------- 1 | ( 2 | eForth 1.04 for j1 Simulator by Edward A., July 2014 3 | Much of the code is derived from the following sources: 4 | j1 Cross-compiler by James Bowman August 2010 5 | 8086 eForth 1.0 by Bill Muench and C. H. Ting, 1990 6 | ) 7 | 8 | only forth definitions hex 9 | 10 | wordlist constant meta.1 11 | wordlist constant target.1 12 | wordlist constant assembler.1 13 | 14 | : (order) ( w wid*n n -- wid*n w n ) 15 | dup if 16 | 1- swap >r recurse over r@ xor if 17 | 1+ r> -rot exit then r> drop then ; 18 | : -order ( wid -- ) get-order (order) nip set-order ; 19 | : +order ( wid -- ) dup >r -order get-order r> swap 1+ set-order ; 20 | 21 | : ]asm ( -- ) assembler.1 +order ; immediate 22 | 23 | get-current meta.1 set-current 24 | 25 | : [a] ( "name" -- ) 26 | parse-word assembler.1 search-wordlist 0= 27 | abort" [a]?" compile, ; immediate 28 | : a: ( "name" -- ) 29 | get-current >r assembler.1 set-current 30 | : r> set-current ; 31 | 32 | target.1 +order meta.1 +order 33 | 34 | a: asm[ ( -- ) assembler.1 -order ; immediate 35 | 36 | create tflash 1000 cells here over erase allot 37 | 38 | variable tdp 39 | 40 | : there tdp @ ; 41 | : tc! tflash + c! ; 42 | : tc@ tflash + c@ ; 43 | : t! over ff and over tc! swap 8 rshift swap 1+ tc! ; 44 | : t@ dup tc@ swap 1+ tc@ 8 lshift or ; 45 | : talign there 1 and tdp +! ; 46 | : tc, there tc! 1 tdp +! ; 47 | : t, there t! 2 tdp +! ; 48 | : $literal [char] " word count dup tc, 0 ?do 49 | count tc, loop drop talign ; 50 | : tallot tdp +! ; 51 | : org tdp ! ; 52 | 53 | a: t 0000 ; 54 | a: n 0100 ; 55 | a: t+n 0200 ; 56 | a: t&n 0300 ; 57 | a: t|n 0400 ; 58 | a: t^n 0500 ; 59 | a: ~t 0600 ; 60 | a: n==t 0700 ; 61 | a: n>t 0900 ; 63 | a: t-1 0a00 ; 64 | a: rt 0b00 ; 65 | a: [t] 0c00 ; 66 | a: n<n 0080 or ; 71 | a: t->r 0040 or ; 72 | a: n->[t] 0020 or ; 73 | a: d-1 0003 or ; 74 | a: d+1 0001 or ; 75 | a: r-1 000c or ; 76 | a: r-2 0008 or ; 77 | a: r+1 0004 or ; 78 | 79 | a: alu 6000 or t, ; 80 | 81 | a: return [a] t 1000 or [a] r-1 [a] alu ; 82 | a: branch 2/ 0000 or t, ; 83 | a: ?branch 2/ 2000 or t, ; 84 | a: call 2/ 4000 or t, ; 85 | 86 | a: literal 87 | dup 8000 and if 88 | ffff xor recurse 89 | [a] ~t [a] alu 90 | else 91 | 8000 or t, 92 | then ; 93 | 94 | variable tlast 95 | variable tuser 96 | 97 | 0001 constant =ver 98 | 0004 constant =ext 99 | 0040 constant =comp 100 | 0080 constant =imed 101 | 7f1f constant =mask 102 | 0002 constant =cell 103 | 0010 constant =base 104 | 0008 constant =bksp 105 | 000a constant =lf 106 | 000d constant =cr 107 | 108 | 4000 constant =em 109 | 0000 constant =cold 110 | 111 | 8 constant =vocs 112 | 80 constant =us 113 | 114 | =em 100 - constant =tib 115 | =tib =us - constant =up 116 | =cold =us + constant =pick 117 | =pick 100 + constant =code 118 | 119 | : thead 120 | talign 121 | tlast @ t, there tlast ! 122 | parse-word dup tc, 0 ?do count tc, loop drop talign ; 123 | : twords 124 | cr tlast @ 125 | begin 126 | dup tflash + count 1f and type space =cell - t@ 127 | ?dup 0= until ; 128 | : [t] 129 | parse-word target.1 search-wordlist 0= 130 | abort" [t]?" >body @ ; immediate 131 | : [last] tlast @ ; immediate 132 | : ( [char] ) parse 2drop ; immediate 133 | : literal [a] literal ; 134 | : lookback there =cell - t@ ; 135 | : call? lookback e000 and 4000 = ; 136 | : call>goto there =cell - dup t@ 1fff and swap t! ; 137 | : safe? lookback e000 and 6000 = lookback 004c and 0= and ; 138 | : alu>return there =cell - dup t@ 1000 or [a] r-1 swap t! ; 139 | : t: 140 | >in @ thead >in ! 141 | get-current >r target.1 set-current create 142 | r> set-current 947947 talign there , does> @ [a] call ; 143 | : exit 144 | call? if 145 | call>goto else safe? if 146 | alu>return else 147 | [a] return 148 | then 149 | then ; 150 | : t; 151 | 947947 <> if 152 | abort" unstructured" then true if 153 | exit else [a] return then ; 154 | : u: 155 | >in @ thead >in ! 156 | get-current >r target.1 set-current create 157 | r> set-current talign tuser @ dup , 158 | [a] literal exit =cell tuser +! does> @ [a] literal ; 159 | : [u] 160 | parse-word target.1 search-wordlist 0= 161 | abort" [t]?" >body @ =up - =cell + ; immediate 162 | : immediate tlast @ tflash + dup c@ =imed or swap c! ; 163 | : compile-only tlast @ tflash + dup c@ =comp or swap c! ; 164 | 165 | 0 tlast ! 166 | =up tuser ! 167 | 168 | : hex# ( u -- addr len ) 0 <# base @ >r hex =lf hold # # # # r> base ! #> ; 169 | : save-hex ( -- ) 170 | parse-word w/o create-file throw 171 | there 0 do i t@ over >r hex# r> write-file throw 2 +loop 172 | close-file throw ; 173 | : save-target ( -- ) 174 | parse-word w/o create-file throw >r 175 | tflash there r@ write-file throw r> close-file ; 176 | 177 | : begin there ; 178 | : until [a] ?branch ; 179 | 180 | : if there 0 [a] ?branch ; 181 | : skip there 0 [a] branch ; 182 | : then begin 2/ over t@ or swap t! ; 183 | : else skip swap then ; 184 | : while if swap ; 185 | : repeat [a] branch then ; 186 | : again [a] branch ; 187 | : aft drop skip begin swap ; 188 | 189 | : noop ]asm t alu asm[ ; 190 | : + ]asm t+n d-1 alu asm[ ; 191 | : xor ]asm t^n d-1 alu asm[ ; 192 | : and ]asm t&n d-1 alu asm[ ; 193 | : or ]asm t|n d-1 alu asm[ ; 194 | : invert ]asm ~t alu asm[ ; 195 | : = ]asm n==t d-1 alu asm[ ; 196 | : < ]asm nn alu asm[ ; 199 | : dup ]asm t t->n d+1 alu asm[ ; 200 | : drop ]asm n d-1 alu asm[ ; 201 | : over ]asm n t->n d+1 alu asm[ ; 202 | : nip ]asm t d-1 alu asm[ ; 203 | : >r ]asm n t->r r+1 d-1 alu asm[ ; 204 | : r> ]asm rt t->n r-1 d+1 alu asm[ ; 205 | : r@ ]asm rt t->n d+1 alu asm[ ; 206 | : @ ]asm [t] alu asm[ ; 207 | : ! ]asm t n->[t] d-1 alu 208 | n d-1 alu asm[ ; 209 | : dsp ]asm dsp t->n d+1 alu asm[ ; 210 | : lshift ]asm n<>t d-1 alu asm[ ; 212 | : 1- ]asm t-1 alu asm[ ; 213 | : 2r> ]asm rt t->n r-1 d+1 alu 214 | rt t->n r-1 d+1 alu 215 | n t->n alu asm[ ; 216 | : 2>r ]asm n t->n alu 217 | n t->r r+1 d-1 alu 218 | n t->r r+1 d-1 alu asm[ ; 219 | : 2r@ ]asm rt t->n r-1 d+1 alu 220 | rt t->n r-1 d+1 alu 221 | n t->n d+1 alu 222 | n t->n d+1 alu 223 | n t->r r+1 d-1 alu 224 | n t->r r+1 d-1 alu 225 | n t->n alu asm[ ; 226 | : unloop 227 | ]asm t r-1 alu 228 | t r-1 alu asm[ ; 229 | 230 | : dup@ ]asm [t] t->n d+1 alu asm[ ; 231 | : dup>r ]asm t t->r r+1 alu asm[ ; 232 | : 2dupxor ]asm t^n t->n d+1 alu asm[ ; 233 | : 2dup= ]asm n==t t->n d+1 alu asm[ ; 234 | : !nip ]asm t n->[t] d-1 alu asm[ ; 235 | : 2dup! ]asm t n->[t] alu asm[ ; 236 | 237 | : up1 ]asm t d+1 alu asm[ ; 238 | : down1 ]asm t d-1 alu asm[ ; 239 | : copy ]asm n alu asm[ ; 240 | 241 | a: down e for down1 next copy exit ; 242 | a: up e for up1 next noop exit ; 243 | 244 | : for >r begin ; 245 | : next r@ while r> 1- >r repeat r> drop ; 246 | 247 | =pick org 248 | 249 | ]asm down up asm[ 250 | 251 | there constant =pickbody 252 | 253 | copy ]asm return asm[ 254 | 9c ]asm call asm[ bc ]asm branch asm[ 255 | 9a ]asm call asm[ ba ]asm branch asm[ 256 | 98 ]asm call asm[ b8 ]asm branch asm[ 257 | 96 ]asm call asm[ b6 ]asm branch asm[ 258 | 94 ]asm call asm[ b4 ]asm branch asm[ 259 | 92 ]asm call asm[ b2 ]asm branch asm[ 260 | 90 ]asm call asm[ b0 ]asm branch asm[ 261 | 8e ]asm call asm[ ae ]asm branch asm[ 262 | 8c ]asm call asm[ ac ]asm branch asm[ 263 | 8a ]asm call asm[ aa ]asm branch asm[ 264 | 88 ]asm call asm[ a8 ]asm branch asm[ 265 | 86 ]asm call asm[ a6 ]asm branch asm[ 266 | 84 ]asm call asm[ a4 ]asm branch asm[ 267 | 82 ]asm call asm[ a2 ]asm branch asm[ 268 | 80 ]asm call asm[ a0 ]asm branch asm[ 269 | ]asm return asm[ 270 | 271 | =cold org 272 | 273 | 0 t, 274 | 275 | there constant =uzero 276 | =base t, ( base ) 277 | 0 t, ( temp ) 278 | 0 t, ( >in ) 279 | 0 t, ( #tib ) 280 | =tib t, ( tib ) 281 | 0 t, ( 'eval ) 282 | 0 t, ( 'abort ) 283 | 0 t, ( hld ) 284 | 285 | ( context ) 286 | 287 | 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 288 | 289 | ( forth-wordlist ) 290 | 291 | 0 t, ( na, of last definition, linked ) 292 | 0 t, ( wid|0, next or last wordlist in chain ) 293 | 0 t, ( na, wordlist name pointer ) 294 | 295 | ( current ) 296 | 297 | 0 t, ( wid, new definitions ) 298 | 0 t, ( wid, head of chain ) 299 | 300 | 0 t, ( dp ) 301 | 0 t, ( last ) 302 | 0 t, ( '?key ) 303 | 0 t, ( 'emit ) 304 | 0 t, ( 'boot ) 305 | 0 t, ( '\ ) 306 | 0 t, ( '?name ) 307 | 0 t, ( '$,n ) 308 | 0 t, ( 'overt ) 309 | 0 t, ( '; ) 310 | 0 t, ( 'create ) 311 | there constant =ulast 312 | =ulast =uzero - constant =udiff 313 | 314 | =code org 315 | 316 | t: noop noop t; 317 | t: + + t; 318 | t: xor xor t; 319 | t: and and t; 320 | t: or or t; 321 | t: invert invert t; 322 | t: = = t; 323 | t: < < t; 324 | t: u< u< t; 325 | t: swap swap t; 326 | t: u> swap u< t; 327 | t: dup dup t; 328 | t: drop drop t; 329 | t: over over t; 330 | t: nip nip t; 331 | t: lshift lshift t; 332 | t: rshift rshift t; 333 | t: 1- 1- t; 334 | t: >r r> swap >r >r t; compile-only 335 | t: r> r> r> swap >r t; compile-only 336 | t: r@ r> r> dup >r swap >r t; compile-only 337 | t: @ ( a -- w ) @ t; 338 | t: ! ( w a -- ) ! t; 339 | 340 | t: <> = invert t; 341 | t: 0< 0 literal < t; 342 | t: 0= 0 literal = t; 343 | t: > swap < t; 344 | t: 0> 0 literal swap < t; 345 | t: >= < invert t; 346 | t: tuck swap over t; 347 | t: -rot swap >r swap r> t; 348 | t: 2/ 1 literal rshift t; 349 | t: 2* 1 literal lshift t; 350 | t: 1+ 1 literal + t; 351 | t: sp@ dsp ff literal and t; 352 | t: execute ( ca -- ) >r t; 353 | t: bye ( -- ) f002 literal ! t; 354 | t: c@ ( b -- c ) 355 | dup @ swap 1 literal and if 356 | 8 literal rshift else ff literal and then exit t; 357 | t: c! ( c b -- ) 358 | swap ff literal and dup 8 literal lshift or swap 359 | tuck dup @ swap 1 literal and 0 literal = ff literal xor 360 | >r over xor r> and xor swap ! t; 361 | t: um+ ( w w -- w cy ) 362 | over over + >r 363 | r@ 0 literal >= >r 364 | over over and 365 | 0< r> or >r 366 | or 0< r> and invert 1+ 367 | r> swap t; 368 | t: dovar ( -- a ) r> t; compile-only 369 | t: up dovar =up t, t; 370 | t: douser ( -- a ) up @ r> @ + t; compile-only 371 | 372 | u: base 373 | u: temp 374 | u: >in 375 | u: #tib 376 | u: tib 377 | u: 'eval 378 | u: 'abort 379 | u: hld 380 | u: context 381 | =vocs =cell * tuser +! 382 | u: forth-wordlist 383 | =cell tuser +! 384 | =cell tuser +! 385 | u: current 386 | =cell tuser +! 387 | u: dp 388 | u: last 389 | u: '?key 390 | u: 'emit 391 | u: 'boot 392 | u: '\ 393 | u: 'name? 394 | u: '$,n 395 | u: 'overt 396 | u: '; 397 | u: 'create 398 | 399 | t: ?dup ( w -- w w | 0 ) dup if dup then exit t; 400 | t: rot ( w1 w2 w3 -- w2 w3 w1 ) >r swap r> swap t; 401 | t: 2drop ( w w -- ) drop drop t; 402 | t: 2dup ( w1 w2 -- w1 w2 w1 w2 ) over over t; 403 | t: negate ( n -- -n ) invert 1+ t; 404 | t: dnegate ( d -- -d ) 405 | invert >r invert 1 literal um+ r> + t; 406 | t: - ( n1 n2 -- n1-n2 ) negate + t; 407 | t: abs ( n -- n ) dup 0< if negate then exit t; 408 | t: max ( n n -- n ) 2dup > if drop exit then nip t; 409 | t: min ( n n -- n ) 2dup < if drop exit then nip t; 410 | t: within ( u ul uh -- t ) over - >r - r> u< t; 411 | t: um/mod ( udl udh u -- ur uq ) 412 | 2dup u< if 413 | negate f literal 414 | for >r dup um+ >r >r dup um+ r> + dup 415 | r> r@ swap >r um+ r> or if 416 | >r drop 1+ r> 417 | else 418 | drop 419 | then r> 420 | next drop swap exit 421 | then drop 2drop -1 literal dup t; 422 | t: m/mod ( d n -- r q ) 423 | dup 0< dup >r if 424 | negate >r dnegate r> 425 | then >r dup 0< if 426 | r@ + 427 | then r> um/mod r> if 428 | swap negate swap then exit t; 429 | t: /mod ( n n -- r q ) over 0< swap m/mod t; 430 | t: mod ( n n -- r ) /mod drop t; 431 | t: / ( n n -- q ) /mod nip t; 432 | t: um* ( u u -- ud ) 433 | 0 literal swap f literal 434 | for dup um+ >r >r dup um+ r> + r> if 435 | >r over um+ r> + then 436 | next rot drop t; 437 | t: * ( n n -- n ) um* drop t; 438 | t: m* ( n n -- d ) 439 | 2dup xor 0< >r abs swap abs um* r> if 440 | dnegate then exit t; 441 | t: */mod ( n1 n2 n3 -- r q ) >r m* r> m/mod t; 442 | t: */ ( n1 n2 n3 -- q ) */mod nip t; 443 | t: cell+ ( a -- a ) =cell literal + t; 444 | t: cell- ( a -- a ) =cell literal - t; 445 | t: cells ( n -- n ) 1 literal lshift t; 446 | t: bl ( -- 32 ) 20 literal t; 447 | t: >char ( c -- c ) 448 | 7f literal and dup 7f literal bl within if 449 | drop 5f literal then exit t; 450 | t: +! ( n a -- ) tuck @ + swap ! t; 451 | t: 2! ( d a -- ) swap over ! cell+ ! t; 452 | t: 2@ ( a -- d ) dup cell+ @ swap @ t; 453 | t: count ( b -- b +n ) dup 1+ swap c@ t; 454 | t: here ( -- a ) dp @ t; 455 | t: aligned ( b -- a ) 456 | dup 0 literal =cell literal um/mod drop dup if 457 | =cell literal swap - then + t; 458 | t: align ( -- ) here aligned dp ! t; 459 | t: pad ( -- a ) here 50 literal + aligned t; 460 | t: @execute ( a -- ) @ ?dup if execute then exit t; 461 | t: fill ( b u c -- ) 462 | swap for swap aft 2dup c! 1+ then next 2drop t; 463 | t: erase 0 literal fill t; 464 | t: digit ( u -- c ) 9 literal over < 7 literal and + 30 literal + t; 465 | t: extract ( n base -- n c ) 0 literal swap um/mod swap digit t; 466 | t: <# ( -- ) pad hld ! t; 467 | t: hold ( c -- ) hld @ 1- dup hld ! c! t; 468 | t: # ( u -- u ) base @ extract hold t; 469 | t: #s ( u -- 0 ) begin # dup while repeat t; 470 | t: sign ( n -- ) 0< if 2d literal hold then exit t; 471 | t: #> ( w -- b u ) drop hld @ pad over - t; 472 | t: str ( n -- b u ) dup >r abs <# #s r> sign #> t; 473 | t: hex ( -- ) 10 literal base ! t; 474 | t: decimal ( -- ) a literal base ! t; 475 | t: digit? ( c base -- u t ) 476 | >r 30 literal - 9 literal over < if 477 | dup 20 literal > if 478 | 20 literal - 479 | then 480 | 7 literal - dup a literal < or 481 | then dup r> u< t; 482 | t: number? ( a -- n t | a f ) 483 | base @ >r 0 literal over count 484 | over c@ 24 literal = if 485 | hex swap 1+ swap 1- then 486 | over c@ 2d literal = >r 487 | swap r@ - swap r@ + ?dup if 488 | 1- 489 | for dup >r c@ base @ digit? 490 | while swap base @ * + r> 1+ 491 | next r@ nip if 492 | negate then swap 493 | else r> r> 2drop 2drop 0 literal 494 | then dup 495 | then r> 2drop r> base ! t; 496 | t: ?rx ( -- c t | f ) f001 literal @ 1 literal and 0= invert t; 497 | t: tx! ( c -- ) 498 | begin 499 | f001 literal @ 2 literal and 0= 500 | until f000 literal ! t; 501 | t: ?key ( -- c ) '?key @execute t; 502 | t: emit ( c -- ) 'emit @execute t; 503 | t: key ( -- c ) 504 | begin 505 | ?key 506 | until f000 literal @ t; 507 | t: nuf? ( -- t ) ?key dup if drop key =cr literal = then exit t; 508 | t: space ( -- ) bl emit t; 509 | t: spaces ( +n -- ) 0 literal max for aft space then next t; 510 | t: type ( b u -- ) for aft count emit then next drop t; 511 | t: cr ( -- ) =cr literal emit =lf literal emit t; 512 | t: do$ ( -- a ) r> r@ r> count + aligned >r swap >r t; compile-only 513 | t: $"| ( -- a ) do$ noop t; compile-only 514 | t: .$ ( a -- ) count type t; 515 | t: ."| ( -- ) do$ .$ t; compile-only 516 | t: .r ( n +n -- ) >r str r> over - spaces type t; 517 | t: u.r ( u +n -- ) >r <# #s #> r> over - spaces type t; 518 | t: u. ( u -- ) <# #s #> space type t; 519 | t: . ( w -- ) base @ a literal xor if u. exit then str space type t; 520 | t: cmove ( b1 b2 u -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop t; 521 | t: pack$ ( b u a -- a ) dup >r 2dup ! 1+ swap cmove r> t; 522 | t: ? ( a -- ) @ . t; 523 | t: (parse) ( b u c -- b u delta ; ) 524 | temp ! over >r dup if 525 | 1- temp @ bl = if 526 | for 527 | count temp @ swap - 0< invert r@ 0> and 528 | while next r> drop 0 literal dup exit 529 | then 1- r> 530 | then over swap 531 | for 532 | count temp @ swap - temp @ bl = if 533 | 0< then 534 | while next dup >r else r> drop dup >r 1- 535 | then over - r> r> - exit 536 | then over r> - t; 537 | t: parse ( c -- b u ; ) 538 | >r 539 | tib @ >in @ + 540 | #tib @ >in @ - r> 541 | (parse) 542 | >in +! t; 543 | t: .( ( -- ) 29 literal parse type t; immediate 544 | t: ( ( -- ) 29 literal parse 2drop t; immediate 545 | t: <\> ( -- ) #tib @ >in ! t; immediate 546 | t: \ ( -- ) '\ @execute t; immediate 547 | t: word ( c -- a ; ) parse here cell+ pack$ t; 548 | t: token ( -- a ; ) bl word t; 549 | t: name> ( na -- ca ) count 1f literal and + aligned t; 550 | t: same? ( a a u -- a a f \ -0+ ) 551 | 1- 552 | for aft over r@ + c@ 553 | over r@ + c@ - ?dup 554 | if r> drop exit then then 555 | next 0 literal t; 556 | t: find ( a va -- ca na | a f ) 557 | swap 558 | dup c@ temp ! 559 | dup @ >r 560 | cell+ swap 561 | begin @ dup 562 | if dup @ =mask literal and r@ xor 563 | if cell+ -1 literal else cell+ temp @ same? then 564 | else r> drop swap cell- swap exit 565 | then 566 | while 2 literal cells - 567 | repeat r> drop nip cell- dup name> swap t; 568 | t: ( a -- ca na | a f ) 569 | context dup 2@ xor if cell- then >r 570 | begin 571 | r> cell+ dup >r @ ?dup 572 | while 573 | find ?dup 574 | until r> drop exit then r> drop 0 literal t; 575 | t: name? ( a -- ca na | a f ) 'name? @execute t; 576 | t: ^h ( bot eot cur -- bot eot cur ) 577 | >r over r@ < dup if 578 | =bksp literal dup emit space 579 | emit then r> + t; 580 | t: tap ( bot eot cur c -- bot eot cur ) 581 | dup emit over c! 1+ t; 582 | t: ktap ( bot eot cur c -- bot eot cur ) 583 | dup =cr literal xor if 584 | =bksp literal xor if 585 | bl tap exit 586 | then ^h exit 587 | then drop nip dup t; 588 | t: accept ( b u -- b u ) 589 | over + over 590 | begin 591 | 2dup xor 592 | while 593 | key dup bl - 7f literal u< if tap else ktap then 594 | repeat drop over - t; 595 | t: query ( -- ) tib @ 50 literal accept #tib ! drop 0 literal >in ! t; 596 | t: abort2 do$ drop t; 597 | t: abort1 space .$ 3f literal emit cr 'abort @execute abort2 t; 598 | t: if do$ abort1 exit then abort2 t; compile-only 599 | t: forget ( -- ) 600 | token name? ?dup if 601 | cell- dup dp ! 602 | @ dup context ! last ! 603 | drop exit 604 | then abort1 t; 605 | t: $interpret ( a -- ) 606 | name? ?dup if 607 | @ =comp literal and 608 | $literal compile-only" execute exit 609 | else number? if 610 | exit then abort1 then t; 611 | t: [ ( -- ) [t] $interpret literal 'eval ! t; immediate 612 | t: .ok ( -- ) 613 | [t] $interpret literal 'eval @ = if 614 | ."| $literal ok" 615 | then cr t; 616 | t: eval ( -- ) 617 | begin 618 | token dup c@ 619 | while 620 | 'eval @execute 621 | repeat drop .ok t; 622 | t: $eval ( a u -- ) 623 | >in @ >r #tib @ >r tib @ >r 624 | [t] >in literal 0 literal swap ! 625 | #tib ! tib ! eval r> tib ! r> #tib ! r> >in ! t; compile-only 626 | t: preset ( -- ) =tib literal #tib cell+ ! t; 627 | t: quit ( -- ) 628 | [ begin 629 | query eval 630 | again t; 631 | t: abort drop preset .ok quit t; 632 | t: ' ( -- ca ) token name? if exit then abort1 t; 633 | t: allot ( n -- ) aligned dp +! t; 634 | t: , ( w -- ) here dup cell+ dp ! ! t; 635 | t: call, ( ca -- ) 1 literal rshift 4000 literal or , t; compile-only 636 | t: ?branch ( ca -- ) 1 literal rshift 2000 literal or , t; compile-only 637 | t: branch ( ca -- ) 1 literal rshift 0000 literal or , t; compile-only 638 | t: [compile] ( -- ; ) ' call, t; immediate 639 | t: compile ( -- ) r> dup @ , cell+ >r t; compile-only 640 | t: recurse last @ name> call, t; immediate 641 | t: pick dup 2* 2* =pickbody literal + >r t; 642 | t: literal ( w -- ) 643 | dup 8000 literal and if 644 | ffff literal xor [t] literal ]asm call asm[ compile invert 645 | else 646 | 8000 literal or , 647 | then exit t; immediate 648 | t: ['] ' [t] literal ]asm call asm[ t; immediate 649 | t: $," ( -- ) 22 literal parse here pack$ count + aligned dp ! t; 650 | t: for ( -- a ) compile [t] >r ]asm call asm[ here t; compile-only immediate 651 | t: begin ( -- a ) here t; compile-only immediate 652 | t: (next) ( n -- ) r> r> ?dup if 1- >r @ >r exit then cell+ >r t; compile-only 653 | t: next ( -- ) compile (next) , t; compile-only immediate 654 | t: (do) ( limit index -- index ) r> dup >r swap rot >r >r cell+ >r t; compile-only 655 | t: do ( limit index -- ) compile (do) 0 literal , here t; compile-only immediate 656 | t: (leave) r> drop r> drop r> drop t; compile-only 657 | t: leave compile (leave) noop t; compile-only immediate 658 | t: (loop) 659 | r> r> 1+ r> 2dup <> if 660 | >r >r @ >r exit 661 | then >r 1- >r cell+ >r t; compile-only 662 | t: (unloop) r> r> drop r> drop r> drop >r t; compile-only 663 | t: unloop compile (unloop) noop t; compile-only immediate 664 | t: (?do) 665 | 2dup <> if 666 | r> dup >r swap rot >r >r cell+ >r exit 667 | then 2drop exit t; compile-only 668 | t: ?do ( limit index -- ) compile (?do) 0 literal , here t; compile-only immediate 669 | t: loop ( -- ) compile (loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate 670 | t: (+loop) 671 | r> swap r> r> 2dup - >r 672 | 2 literal pick r@ + r@ xor 0< 0= 673 | 3 literal pick r> xor 0< 0= or if 674 | >r + >r @ >r exit 675 | then >r >r drop cell+ >r t; compile-only 676 | t: +loop ( n -- ) compile (+loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate 677 | t: (i) ( -- index ) r> r> tuck >r >r t; compile-only 678 | t: i ( -- index ) compile (i) noop t; compile-only immediate 679 | t: until ( a -- ) ?branch t; compile-only immediate 680 | t: again ( a -- ) branch t; compile-only immediate 681 | t: if ( -- a ) here 0 literal ?branch t; compile-only immediate 682 | t: then ( a -- ) here 1 literal rshift over @ or swap ! t; compile-only immediate 683 | t: repeat ( a a -- ) branch [t] then ]asm call asm[ t; compile-only immediate 684 | t: skip here 0 literal branch t; compile-only immediate 685 | t: aft ( a -- a a ) drop [t] skip ]asm call asm[ [t] begin ]asm call asm[ swap t; compile-only immediate 686 | t: else ( a -- a ) [t] skip ]asm call asm[ swap [t] then ]asm call asm[ t; compile-only immediate 687 | t: while ( a -- a a ) [t] if ]asm call asm[ swap t; compile-only immediate 688 | t: (case) r> swap >r >r t; compile-only 689 | t: case compile (case) 30 literal t; compile-only immediate 690 | t: (of) r> r@ swap >r = t; compile-only 691 | t: of compile (of) [t] if ]asm call asm[ t; compile-only immediate 692 | t: endof [t] else ]asm call asm[ 31 literal t; compile-only immediate 693 | t: (endcase) r> r> drop >r t; 694 | t: endcase 695 | begin 696 | dup 31 literal = 697 | while 698 | drop 699 | [t] then ]asm call asm[ 700 | repeat 701 | 30 literal <> $literal bad case construct." 702 | compile (endcase) noop t; compile-only immediate 703 | t: $" ( -- ; ) compile $"| $," t; compile-only immediate 704 | t: ." ( -- ; ) compile ."| $," t; compile-only immediate 705 | t: >body ( ca -- pa ) cell+ t; 706 | t: (to) ( n -- ) r> dup cell+ >r @ ! t; compile-only 707 | t: to ( n -- ) compile (to) ' >body , t; compile-only immediate 708 | t: (+to) ( n -- ) r> dup cell+ >r @ +! t; compile-only 709 | t: +to ( n -- ) compile (+to) ' >body , t; compile-only immediate 710 | t: get-current ( -- wid ) current @ t; 711 | t: set-current ( wid -- ) current ! t; 712 | t: definitions ( -- ) context @ set-current t; 713 | t: ?unique ( a -- a ) 714 | dup get-current find if ."| $literal redef " over .$ then drop t; 715 | t: <$,n> ( na -- ) 716 | dup c@ if 717 | ?unique 718 | dup count + aligned 719 | dp ! 720 | dup last ! 721 | cell- 722 | get-current @ 723 | swap ! exit 724 | then drop $"| $literal name" abort1 t; 725 | t: $,n ( na -- ) '$,n @execute t; 726 | t: $compile ( a -- ) 727 | name? ?dup if 728 | @ =imed literal and if 729 | execute exit 730 | else call, exit 731 | then 732 | then 733 | number? if 734 | [t] literal ]asm call asm[ exit then abort1 t; 735 | t: abort" compile $," t; immediate 736 | t: ( -- ) last @ get-current ! t; 737 | t: overt ( -- ) 'overt @execute t; 738 | t: exit r> drop t; 739 | t: <;> ( -- ) 740 | compile [t] exit ]asm call asm[ 741 | [ overt 0 literal here ! t; compile-only immediate 742 | t: ; ( -- ) '; @execute t; compile-only immediate 743 | t: ] ( -- ) [t] $compile literal 'eval ! t; 744 | t: : ( -- ; ) token $,n ] t; 745 | t: immediate ( -- ) =imed literal last @ @ or last @ ! t; 746 | t: user ( u -- ; ) token $,n overt compile douser , t; 747 | t: ( -- ; ) token $,n overt [t] dovar ]asm literal asm[ call, t; 748 | t: create ( -- ; ) 'create @execute t; 749 | t: variable ( -- ; ) create 0 literal , t; 750 | t: (does>) ( -- ) 751 | r> 1 literal rshift here 1 literal rshift 752 | last @ name> dup cell+ ]asm 8000 literal asm[ or , ! , t; compile-only 753 | t: compile-only ( -- ) =comp literal last @ @ or last @ ! t; 754 | t: does> ( -- ) compile (does>) noop t; immediate 755 | t: char ( -- char ) ( -- c ) bl word 1+ c@ t; 756 | t: [char] char [t] literal ]asm call asm[ t; immediate 757 | t: constant create , (does>) @ t; 758 | t: defer create 0 literal , 759 | (does>) 760 | @ ?dup 0 literal = 761 | $literal uninitialized" execute t; 762 | t: is ' >body ! t; immediate 763 | t: .id ( na -- ) 764 | ?dup if 765 | count 1f literal and type exit then 766 | cr ."| $literal {noname}" t; 767 | t: wordlist ( -- wid ) align here 0 literal , dup current cell+ dup @ , ! 0 literal , t; 768 | t: order@ ( a -- u*wid u ) dup @ dup if >r cell+ order@ r> swap 1+ exit then nip t; 769 | t: get-order ( -- u*wid u ) context order@ t; 770 | t: >wid ( wid -- ) cell+ t; 771 | t: .wid ( wid -- ) 772 | space dup >wid cell+ @ ?dup if .id drop exit then 0 literal u.r t; 773 | t: !wid ( wid -- ) >wid cell+ last @ swap ! t; 774 | t: vocs ( -- ) ( list all wordlists ) 775 | cr ."| $literal vocs:" current cell+ 776 | begin 777 | @ ?dup 778 | while 779 | dup .wid >wid 780 | repeat t; 781 | t: order ( -- ) ( list search order ) 782 | cr ."| $literal search:" get-order 783 | begin 784 | ?dup 785 | while 786 | swap .wid 1- 787 | repeat 788 | cr ."| $literal define:" get-current .wid t; 789 | t: set-order ( u*wid n -- ) ( 16.6.1.2197 ) 790 | dup -1 literal = if 791 | drop forth-wordlist 1 literal then 792 | =vocs literal over u< $literal over size of #vocs" 793 | context swap 794 | begin 795 | dup 796 | while 797 | >r swap over ! cell+ r> 798 | 1- 799 | repeat swap ! t; 800 | t: only ( -- ) -1 literal set-order t; 801 | t: also ( -- ) get-order over swap 1+ set-order t; 802 | t: previous ( -- ) get-order swap drop 1- set-order t; 803 | t: >voc ( wid 'name' -- ) 804 | create dup , !wid 805 | (does>) 806 | @ >r get-order swap drop r> swap set-order t; 807 | t: widof ( "vocabulary" -- wid ) ' >body @ t; 808 | t: vocabulary ( 'name' -- ) wordlist >voc t; 809 | t: _type ( b u -- ) for aft count >char emit then next drop t; 810 | t: dm+ ( a u -- a ) 811 | over 4 literal u.r space 812 | for aft count 3 literal u.r then next t; 813 | t: dump ( a u -- ) 814 | base @ >r hex 10 literal / 815 | for cr 10 literal 2dup dm+ -rot 816 | 2 literal spaces _type 817 | next drop r> base ! t; 818 | t: .s ( ... -- ... ) cr sp@ 1- f literal and for r@ pick . next ."| $literal name) ( ca va -- na | f ) 820 | begin 821 | @ ?dup 822 | while 823 | 2dup name> xor 824 | while cell- 825 | repeat nip exit 826 | then drop 0 literal t; 827 | t: >name ( ca -- na | f ) 828 | >r get-order 829 | begin 830 | ?dup 831 | while 832 | swap 833 | r@ swap 834 | (>name) 835 | ?dup if 836 | >r 837 | 1- for aft drop then next 838 | r> r> drop 839 | exit 840 | then 841 | 1- 842 | repeat 843 | r> drop 0 literal t; 844 | t: see ( -- ; ) 845 | ' cr 846 | begin 847 | dup @ ?dup 700c literal xor 848 | while 849 | 3fff literal and 1 literal lshift 850 | >name ?dup if 851 | space .id 852 | else 853 | dup @ 7fff literal and u. 854 | then 855 | cell+ 856 | repeat 2drop t; 857 | t: (words) ( -- ) 858 | cr 859 | begin 860 | @ ?dup 861 | while 862 | dup .id space cell- 863 | repeat t; 864 | t: words 865 | get-order 866 | begin 867 | ?dup 868 | while 869 | swap 870 | cr cr ."| $literal :" dup .wid cr 871 | (words) 872 | 1- 873 | repeat t; 874 | t: ver ( -- n ) =ver literal 100 literal * =ext literal + t; 875 | t: hi ( -- ) 876 | cr ."| $literal eforth j1 v" 877 | base @ hex 878 | ver <# # # 2e literal hold # #> 879 | type base ! cr t; 880 | t: cold ( -- ) 881 | =uzero literal =up literal =udiff literal cmove 882 | preset forth-wordlist dup context ! dup current 2! overt 883 | 4000 literal cell+ dup cell- @ $eval 884 | 'boot @execute 885 | quit 886 | cold t; 887 | 888 | target.1 -order set-current 889 | 890 | there [u] dp t! 891 | [last] [u] last t! 892 | [t] ?rx [u] '?key t! 893 | [t] tx! [u] 'emit t! 894 | [t] <\> [u] '\ t! 895 | [t] $interpret [u] 'eval t! 896 | [t] abort [u] 'abort t! 897 | [t] hi [u] 'boot t! 898 | [t] [u] 'name? t! 899 | [t] [u] 'overt t! 900 | [t] <$,n> [u] '$,n t! 901 | [t] <;> [u] '; t! 902 | [t] [u] 'create t! 903 | [t] cold 2/ =cold t! 904 | 905 | save-target j1.bin 906 | save-hex j1.hex 907 | 908 | meta.1 -order 909 | 910 | bye 911 | -------------------------------------------------------------------------------- /j1.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #if defined(unix) || defined(__unix__) || defined(__unix) || (defined(__APPLE__) && defined(__MACH__)) 8 | #include 9 | #include 10 | int getch(void) { /* reads from keypress, doesn't echo */ 11 | struct termios oldattr, newattr; 12 | int ch; 13 | tcgetattr( STDIN_FILENO, &oldattr ); 14 | newattr = oldattr; 15 | newattr.c_iflag &= ~( ICRNL ); 16 | newattr.c_lflag &= ~( ICANON | ECHO ); 17 | tcsetattr( STDIN_FILENO, TCSANOW, &newattr ); 18 | ch = getchar(); 19 | tcsetattr( STDIN_FILENO, TCSANOW, &oldattr ); 20 | // printf("%d\n", ch); 21 | if(ch==0x1b) exit(0); 22 | return ch==127 ? 8 : ch; 23 | } 24 | int putch(int c) { /* output character to sstdout & flush */ 25 | int res=putchar(c); 26 | fflush(stdout); 27 | return res; 28 | } 29 | #endif 30 | int len = 0; 31 | static pcap_t* handle = NULL; 32 | static void pcapdev_init(void) { 33 | char errbuf[PCAP_ERRBUF_SIZE]; 34 | pcap_if_t* devices; 35 | if (pcap_findalldevs(&devices, errbuf) == -1) { 36 | fprintf(stderr, "error pcap_findalldevs: %s\n", errbuf); 37 | return; 38 | } 39 | pcap_if_t* device; 40 | for(device = devices; device; device = device->next) { 41 | if (device->description) { 42 | printf(" (%s)\n", device->description); 43 | } 44 | else { 45 | fprintf(stderr, "no device\n"); 46 | return; 47 | } 48 | } 49 | device = devices->next->next; 50 | if (NULL == (handle= pcap_open_live(device->name 51 | , 65536, 1, 10 , errbuf))) { 52 | fprintf(stderr, "\nUnable to open the adapter. %s is not supported by WinPcap\n"); 53 | pcap_freealldevs(devices); 54 | return; 55 | } 56 | pcap_freealldevs(devices); 57 | } 58 | static unsigned short t; 59 | static unsigned short s; 60 | static unsigned short d[0x20]; /* data stack */ 61 | static unsigned short r[0x20]; /* return stack */ 62 | static unsigned short pc; /* program counter, counts cells */ 63 | static unsigned char dsp, rsp; /* point to top entry */ 64 | static unsigned short* memory; /* ram */ 65 | static int sx[4] = { 0, 1, -2, -1 }; /* 2-bit sign extension */ 66 | 67 | static void push(int v) // push v on the data stack 68 | { 69 | dsp = 0x1f & (dsp + 1); 70 | d[dsp] = t; 71 | t = v; 72 | } 73 | 74 | static int pop(void) // pop value from the data stack and return it 75 | { 76 | int v = t; 77 | t = d[dsp]; 78 | dsp = 0x1f & (dsp - 1); 79 | return v; 80 | } 81 | char eth_poll() { 82 | const u_char* packet; 83 | struct pcap_pkthdr* header; 84 | int res = 0; 85 | while (res == 0) 86 | { 87 | res = pcap_next_ex(handle, &header, &packet); 88 | } 89 | len = (int)header->len; 90 | memcpy(&memory[0x2000], packet, len); 91 | return len; 92 | } 93 | void eth_transmit(void) { 94 | if ((pcap_sendpacket(handle, (char *)(&memory[0x2000]), len) == -1)) 95 | { 96 | printf("sorry send error\n"); 97 | exit(1); 98 | } 99 | } 100 | 101 | static void execute(int entrypoint) 102 | { 103 | int _pc, _t; 104 | int insn = 0x4000 | entrypoint; // first insn: "call entrypoint" 105 | pcapdev_init(); 106 | do { 107 | _pc = pc + 1; 108 | if (insn & 0x8000) { // literal 109 | push(insn & 0x7fff); 110 | } else { 111 | int target = insn & 0x1fff; 112 | switch (insn >> 13) { 113 | case 0: // jump 114 | _pc = target; 115 | break; 116 | case 1: // conditional jump 117 | if (pop() == 0) 118 | _pc = target; 119 | break; 120 | case 2: // call 121 | rsp = 31 & (rsp + 1); 122 | r[rsp] = _pc << 1; 123 | _pc = target; 124 | break; 125 | case 3: // alu 126 | if (insn & 0x1000) {/* r->pc */ 127 | _pc = r[rsp] >> 1; 128 | } 129 | s = d[dsp]; 130 | switch ((insn >> 8) & 0xf) { 131 | case 0: _t = t; break; /* noop */ 132 | case 1: _t = s; break; /* copy */ 133 | case 2: _t = t+s; break; /* + */ 134 | case 3: _t = t&s; break; /* and */ 135 | case 4: _t = t|s; break; /* or */ 136 | case 5: _t = t^s; break; /* xor */ 137 | case 6: _t = ~t; break; /* invert */ 138 | case 7: _t = -(t==s); break; /* = */ 139 | case 8: _t = -((signed short)s < (signed short)t); break; /* < */ 140 | case 9: _t = s>>t; break; /* rshift */ 141 | case 0xa: _t = t-1; break; /* 1- */ 142 | case 0xb: _t = r[rsp]; break; /* r@ */ 143 | case 0xc: _t = (t==0xf008)?eth_poll():(t==0xf001)?1:(t==0xf000)?getch():memory[t>>1]; break; /* @ */ 144 | case 0xd: _t = s<> 2) & 3]); /* rstack+- */ 150 | if (insn & 0x80) /* t->s */ 151 | d[dsp] = t; 152 | if (insn & 0x40) /* t->r */ 153 | r[rsp] = t; 154 | if (insn & 0x20) /* s->[t] */ 155 | (t==0xf008)?eth_transmit(): (t==0xf002)?(rsp=0):(t==0xf000)?putch(s):(memory[t>>1]=s); /* ! */ 156 | t = _t; 157 | break; 158 | } 159 | } 160 | pc = _pc; 161 | insn = memory[pc]; 162 | } while (1); 163 | } 164 | /* end of cpu */ 165 | 166 | /* start of i/o demo */ 167 | 168 | 169 | int main(int argc , char *argv[]) 170 | { 171 | unsigned short m[0x4000]; /* 32kb or RAM */ 172 | FILE *f = fopen("j1.bin", "rb"); 173 | fread(m, 0x2000, sizeof(m[0]), f); /* 0kb - 16kb data and code */ 174 | fclose(f); 175 | if (argc>1) { // program name is counted as one 176 | struct stat st; 177 | f = fopen(argv[1], "r"); 178 | stat(argv[1], &st); 179 | (&m[0x2000])[0] = st.st_size; /* 16kb - 32kb memory mapped i/o */ 180 | fread(&m[0x2001], 0x2000, sizeof(m[0]), f); 181 | fclose(f); 182 | } 183 | memory = m; 184 | execute(0x00); 185 | return 0; 186 | } 187 | --------------------------------------------------------------------------------