├── ADC-L ├── ADC-LD ├── DIA ├── I2ISR ├── IO ├── MARK ├── Makefile ├── OLED ├── README.md ├── RTC ├── ] 69 | 06 c, 01 c, 51 c, 09 c, 06 c, \ ? 70 | 3E c, 41 c, 49 c, 15 c, 1E c, \ @ 71 | 78 c, 16 c, 11 c, 16 c, 78 c, \ A 72 | 7F c, 49 c, 49 c, 49 c, 36 c, \ B 73 | 3E c, 41 c, 41 c, 41 c, 22 c, \ C 74 | 7F c, 41 c, 41 c, 41 c, 3E c, \ D 75 | 7F c, 49 c, 49 c, 49 c, 49 c, \ E 76 | 7F c, 09 c, 09 c, 09 c, 09 c, \ F 77 | 3E c, 41 c, 41 c, 49 c, 7B c, \ G 78 | 7F c, 08 c, 08 c, 08 c, 7F c, \ H 79 | 00 c, 41 c, 7F c, 41 c, 00 c, \ I 80 | 38 c, 40 c, 40 c, 41 c, 3F c, \ J 81 | 7F c, 08 c, 08 c, 14 c, 63 c, \ K 82 | 7F c, 40 c, 40 c, 40 c, 40 c, \ L 83 | 7F c, 06 c, 18 c, 06 c, 7F c, \ M 84 | 7F c, 06 c, 18 c, 60 c, 7F c, \ N 85 | 3E c, 41 c, 41 c, 41 c, 3E c, \ O 86 | 7F c, 09 c, 09 c, 09 c, 06 c, \ P 87 | 3E c, 41 c, 51 c, 21 c, 5E c, \ Q 88 | 7F c, 09 c, 19 c, 29 c, 46 c, \ R 89 | 26 c, 49 c, 49 c, 49 c, 32 c, \ S 90 | 01 c, 01 c, 7F c, 01 c, 01 c, \ T 91 | 3F c, 40 c, 40 c, 40 c, 7F c, \ U 92 | 0F c, 30 c, 40 c, 30 c, 0F c, \ V 93 | 1F c, 60 c, 1C c, 60 c, 1F c, \ W 94 | 63 c, 14 c, 08 c, 14 c, 63 c, \ X 95 | 03 c, 04 c, 78 c, 04 c, 03 c, \ Y 96 | 61 c, 51 c, 49 c, 45 c, 43 c, \ Z 97 | 00 c, 7F c, 41 c, 00 c, 00 c, \ [ 98 | 00 c, 03 c, 1C c, 60 c, 00 c, \ \ 99 | 00 c, 41 c, 7F c, 00 c, 00 c, \ ] 100 | 0C c, 02 c, 01 c, 02 c, 0C c, \ ^ 101 | 40 c, 40 c, 40 c, 40 c, 40 c, \ _ 102 | 00 c, 01 c, 02 c, 04 c, 00 c, \ ` 103 | 20 c, 54 c, 54 c, 54 c, 78 c, \ a 104 | 7F c, 48 c, 44 c, 44 c, 38 c, \ b 105 | 38 c, 44 c, 44 c, 44 c, 44 c, \ c 106 | 38 c, 44 c, 44 c, 48 c, 7F c, \ d 107 | 38 c, 54 c, 54 c, 54 c, 18 c, \ e 108 | 08 c, 7E c, 09 c, 09 c, 00 c, \ f 109 | 0C c, 52 c, 52 c, 54 c, 3E c, \ g 110 | 7F c, 08 c, 04 c, 04 c, 78 c, \ h 111 | 00 c, 00 c, 7D c, 00 c, 00 c, \ i 112 | 00 c, 40 c, 3D c, 00 c, 00 c, \ j 113 | 7F c, 10 c, 28 c, 44 c, 00 c, \ k 114 | 00 c, 00 c, 3F c, 40 c, 00 c, \ l 115 | 7C c, 04 c, 18 c, 04 c, 78 c, \ m 116 | 7C c, 08 c, 04 c, 04 c, 78 c, \ n 117 | 38 c, 44 c, 44 c, 44 c, 38 c, \ o 118 | 7F c, 12 c, 11 c, 11 c, 0E c, \ p 119 | 0E c, 11 c, 11 c, 12 c, 7F c, \ q 120 | 00 c, 7C c, 08 c, 04 c, 04 c, \ r 121 | 48 c, 54 c, 54 c, 54 c, 24 c, \ s 122 | 04 c, 3E c, 44 c, 44 c, 00 c, \ t 123 | 3C c, 40 c, 40 c, 20 c, 7C c, \ u 124 | 1C c, 20 c, 40 c, 20 c, 1C c, \ v 125 | 1C c, 60 c, 18 c, 60 c, 1C c, \ w 126 | 44 c, 28 c, 10 c, 28 c, 44 c, \ x 127 | 46 c, 28 c, 10 c, 08 c, 06 c, \ y 128 | 44 c, 64 c, 54 c, 4C c, 44 c, \ z 129 | 00 c, 08 c, 77 c, 41 c, 00 c, \ { 130 | 00 c, 00 c, 7F c, 00 c, 00 c, \ | 131 | 00 c, 41 c, 77 c, 08 c, 00 c, \ } 132 | 10 c, 08 c, 18 c, 10 c, 08 c, \ ~ 133 | decimal 134 | 135 | RAM 136 | -------------------------------------------------------------------------------- /I2ISR: -------------------------------------------------------------------------------- 1 | \ STM8 eForth: I2C Master ISR for the STM8 I2C peripheral TG9541 - 201205 2 | \ ------------------------------------------------------------------------------ 3 | \ This is a variant of Thomas' I2C ISR, with an extra three bytes in the I2ISR array 4 | \ for a command pointer and counter. (367 bytes) 5 | 6 | \ The I2ISR I2C ISR code acts as a driver for I2C write/read transfers 7 | 8 | \ Register definitions in this file are the same for STM8S and STM8L: 9 | \ load the I2ISR code after e.g. "\res MCU: STM8L051" in the application code 10 | \ see "\\ Example" at the end of this file 11 | 12 | \ API: 13 | \ * I2ISR array, acts as an ISR "register file" 14 | \ - byte 0: ER < 0 indicates error (bits 6:0 copied from I2C_SR2) 15 | \ - byte 1: SA slave address (0..127) 16 | \ - byte 2: CCOUNT number of command bytes 17 | \ - byte 3: TCOUNT number of bytes in write phase 18 | \ - byte 4: RCOUNT number of bytes in read phase 19 | \ - byte 5,6 : CPOINT command buffer pointer 20 | \ - addr 7,8 : TPOINT transmit buffer pointer 21 | \ - addr 9,10: RPOINT receive buffer pointer 22 | \ * I2S ( c -- ) start I2C sequence defined by I2ISR registers 23 | 24 | \ Usage notes: 25 | \ * use I2S to set 7bit slave address and reset error 26 | \ * use ?I2D to check for error (indicated by I2ISR MSB) 27 | \ * use ?I2E to check for error (indicated by I2ISR MSB) 28 | \ * CPOINT points to a buffer or variable that contains the 29 | \ I2C slave "command" (e.g. DS1621 temperture sensor) or "memory 30 | \ address" (e.g. 24C64 EEPROM). 31 | \ TPOINT points to the data to be written 32 | \ * RPOINT contains the read target buffer or variable address 33 | \ while CPOINT points to I2C slave "command" or "address" data 34 | 35 | 36 | \ temporary words 37 | #require MARK 38 | MARK Mi2c 39 | 40 | \res MCU: STM8S103 41 | \res export I2C_CR1 I2C_CR2 I2C_DR 42 | \res export I2C_SR1 I2C_SR2 I2C_SR3 43 | \res export INT_I2C I2C_ITR 44 | 45 | #require WIPE 46 | #require :NVM 47 | #require ]B! 48 | #require ]C! 49 | #require ]B? 50 | 51 | \ Load Forth IF .. ELSE .. THEN with relative addressing 52 | #require ]B@IF 53 | #require ]C@IF 54 | #require ]AREL \ JRNE IF, exit if error 67 | $C6 C, I2C_SR3 , \ LD A, I2C_SR3 68 | $A402 , \ AND A, #2, BUSY 69 | $CA C, I2ISR 2+ , \ LD A, CCOUNT 70 | $CA C, I2ISR 3 + , \ OR A, TCOUNT 71 | $CA C, I2ISR 4 + , \ 0R A, RCOUNT 72 | $26 C, \ JRNE M 73 | SWAP \ swap branch pointers 74 | ]REL \ JRNE, CCOUNT C@ TCOUNT C@ OR 0= IF 101 | $725D , I2ISR 4 + , ] \ TNZ RCOUNT 102 | JREQ [ \ RCOUNT C@ IF 103 | $5C C, \ INC X ; set R flag 104 | ======= 105 | $CA C, I2ISR 3 + , \ TCOUNT OR 106 | $26 C, >REL \ JRNE, CCOUNT C@ TCOUNT C@ OR 0= IF 107 | $725D , I2ISR 4 + , ] \ TNZ RCOUNT 108 | JREQ [ \ RCOUNT C@ IF 109 | $5C C, \ INC X ; set R flag 110 | >>>>>>> 0363bd7... update 111 | THEN 112 | THEN 113 | [ $9FC7 , I2C_DR , ] \ LD A,XL LD I2C_DR,A ; send device address 114 | THEN 115 | 116 | \ EV6 ADDR has just been sent - trigger next steps or STOP 117 | [ I2C_SR1 1 ( ADDR ) ]B@IF [ \ EV6 118 | $C6 C, I2C_SR1 , \ CLR ADDR by reading SR1 119 | $C6 C, I2C_SR3 , ] \ followed by SR3 120 | [ I2C_SR3 2 ]B@IF [ \ if transmitting 121 | $C6 C, I2ISR 2 + , \ LD A,CCOUNT 122 | $CA C, I2ISR 3 + , \ TCOUNT OR 123 | $26 C, >REL ] ( IF ) \ JRNE rel 124 | [ 1 I2C_CR2 1 ]B! \ dummy access (e.g. scan) 125 | THEN 126 | ELSE [ 127 | $C6 C, I2ISR 4 + , \ LD A,RCOUNT 128 | $4A C, \ DEC A 129 | \ EV6_1 1-byte reception 130 | $26 C, >REL ] ( IF ) \ JRNE rel 131 | [ 0 I2C_CR2 2 ]B! \ ACK disable 132 | [ 1 I2C_CR2 1 ]B! \ end read sequence 133 | THEN 134 | THEN 135 | [ 1 I2C_ITR 2 ]B! \ enable buffer interrupt 136 | THEN 137 | 138 | \ EV7 reveive bytes 139 | [ I2C_SR1 6 ( RXNE ) ]B@IF [ 140 | $C6 C, I2C_DR , \ LD A,I2C_DR 141 | $88 C, \ PUSH A 142 | \ EV7_1 reveive 2nd to last byte, prepare stop 143 | I2ISR 4 + ]C@IF \ like "?DUP IF" with TOS in A 144 | [ 3 ]A $23, PA0 => $00 4 | \ O-PP-F 1 m! sets PA1 in fast output mode push/pull 5 | \ $10 io. displays register settings for PB0 6 | \ 1 $34 io! sets PD4_ODR 7 | \ 1 iox toggles PA1_ODR 8 | 9 | #require MARK 10 | mark IO.FS 11 | 12 | #require MARKER 13 | 14 | MARKER regs 15 | 16 | \ Relative register addresses 17 | $5000 CONSTANT GPIO-BASE 18 | 0 CONSTANT GPIO.ODR 19 | 1 CONSTANT GPIO.IDR 20 | 2 CONSTANT GPIO.DDR 21 | 3 CONSTANT GPIO.CR1 22 | 4 CONSTANT GPIO.CR2 23 | 24 | NVM 25 | 26 | : 0<> ( n --- f) 0 = not ; \ not equal to zero 27 | : lshift ( n --- n) \ shift left n bits 28 | DUP IF 29 | 0 DO 2* LOOP 30 | ELSE DROP 31 | THEN 32 | ; 33 | 34 | \ turn a bit position into a mask 35 | : bit ( u -- u ) 1 swap lshift ; 36 | 37 | \ hexadicimal output 38 | : h. base @ swap hex . base ! ; 39 | 40 | 41 | \ gpio modes, see STM8S-RefManual 11.3 42 | : O-PP %110 ; \ output push/pull 43 | : O-PP-F %111 ; \ output push/pull fast 44 | : O-OD %100 ; \ output open drain 45 | : O-OD-F %101 ; \ output open drain fast 46 | : I-F %000 ; \ input floating 47 | : I-F-I %001 ; \ input floating with interrupt 48 | : I-P %010 ; \ input pull-up 49 | : I-P-I %011 ; \ input pull-up with interrupt 50 | 51 | \ pin = $port#pin# e.g. $13 = PB3, $0 = PA0, $37 = PD7 52 | 53 | \ Convert pin to register address 54 | : io-b ( pin -- GPIO.BASE) 55 | $F0 and $F / 5 * GPIO-BASE + ; 56 | 57 | \ Convert pin to pin# 58 | : io# ( pin -- pin#) $F and ; 59 | 60 | \ Convert pin to port name 61 | : io-p $F / &65 + emit ; 62 | 63 | \ Set gpio registers e.g. 1 GPIO.DDR $23 io-r! sets DDR bit of PC3 64 | : io-r! ( f reg pin --) 65 | dup io-b rot + swap io# b! 66 | ; 67 | 68 | \ Set pin mode e.g. o-pp $23 m! configures PC3 as output port push/pull 69 | : m! ( mode pin --) 70 | 2dup 2dup swap 4 / GPIO.DDR rot io-r! 71 | swap 2 / 1 and GPIO.CR1 rot io-r! 72 | swap 1 and GPIO.CR2 rot io-r! 73 | ; 74 | 75 | \ Convert pin to mask 76 | : io-m ( pin -- m) io# bit ; 77 | 78 | \ Get pin value 79 | : io@ ( pin -- f) 80 | dup io-m swap 81 | io-b GPIO.IDR + C@ and 0<> negate 82 | ; 83 | 84 | \ Set pin 85 | : io! ( f pin -- ) 86 | dup io-b GPIO.ODR + swap io# b! 87 | ; 88 | 89 | \ Toggle pin 90 | : iox ( pin -- ) 91 | dup io@ ( p f) 0= swap io! 92 | ; 93 | 94 | \ display GPIO registers associated with a pin 95 | : io. ( pin -- ) 96 | cr dup io-m >R ( pin) 97 | ." Base-addr:0x" dup io-b dup h. 98 | ." PIN:" swap dup io# . 99 | ." PORT: " dup io-p 100 | io-b ( addr-b) 101 | ." ODR:" dup c@ R@ ( addrb b m) and 0<> negate . 1 + 102 | ." IDR:" dup c@ R@ and 0<> negate . 1 + 103 | ." DDR:" dup c@ R@ and 0<> negate . 1 + 104 | ." CR1:" dup c@ R@ and 0<> negate . 1 + 105 | ." CR2:" c@ R> and 0<> negate . drop 106 | ; 107 | 108 | regs 109 | -------------------------------------------------------------------------------- /MARK: -------------------------------------------------------------------------------- 1 | \ Set mark in NVM. 2 | \ Calling the mark removes all words 3 | \ defined since the mark plus the mark itself from NVM. 4 | 5 | #require :NVM 6 | #require ULOCKF 7 | #require LOCKF 8 | :NVM \ Create headerless word 9 | LAST DUP DUP 10 | 2- @ SWAP @ ROT 6 + @ \ Get context 11 | CREATE , , , 12 | DOES> ULOCKF 'BOOT &12 + 6 CMOVE LOCKF COLD 13 | ;NVM 14 | 15 | : MARK NVM [ $CD C, , ] RAM ; 16 | RAM 17 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | STM8EF_BOARD=MINDEV 2 | STM8EF_VER=2.2.27.pre1 3 | STM8EF_BIN=stm8ef-bin.zip 4 | STM8EF_URL=https://github.com/TG9541/stm8ef/releases/download/${STM8EF_VER}/${STM8EF_BIN} 5 | 6 | all: flash 7 | 8 | defaults: 9 | stm8flash -c stlinkv2 -p stm8s103f3 -s opt -w tools/stm8s103FactoryDefaults.bin 10 | 11 | flash: depend 12 | stm8flash -c stlinkv2 -p stm8s103f3 -w out/MINDEV/MINDEV.ihx 13 | 14 | load: depend 15 | tools/codeload.py serial main.fs 16 | 17 | simload: depend 18 | tools/simload.sh $(STM8EF_BOARD) 19 | 20 | depend: 21 | if [ ! -d "out" ]; then \ 22 | curl -# -L -O ${STM8EF_URL}; \ 23 | unzip -q -o ${STM8EF_BIN} -x out/*; \ 24 | unzip -q -o ${STM8EF_BIN} out/${STM8EF_BOARD}/*; \ 25 | rm ${STM8EF_BIN}; \ 26 | ln -s out/${STM8EF_BOARD}/target target; \ 27 | fi 28 | 29 | clean: 30 | rm -rf target FORTH.efr STM8S103.efr STM8S105.efr docs lib inc mcu out tools forth.asm forth.mk README.md LICENSE.md 31 | -------------------------------------------------------------------------------- /OLED: -------------------------------------------------------------------------------- 1 | \ Driver for ssd1306 oled display 128x64 over i2c 2 | \ (459 bytes) 3 | 4 | \ ssdi ( --) initialise i2c and ssd1306-display 5 | \ cls ( --) clear screen 6 | \ dtxt ( adr --) display text compiled with $" 7 | \ Text has to be compiled before it can be displayed. 8 | \ : txt $" text to be displayed" ; 9 | \ txt dtxt will display "text to be displayed" on the oled screen. 10 | \ d# ( n --) display number 11 | \ 1234 d# will display "1234". 12 | 13 | \ The display has 8 pages (lines) of 128x8 dots. Positioning is done by sending display commands: 14 | \ snd (b b .. b0 n --) send multiple (n) display commands, last byte b0 = 0 for positioning 15 | \ b0 = $40 for dots to display 16 | 17 | \ Display positioning commands: 18 | \ $B0 - $B7 Vertical position: Line 0 - line7 19 | \ 0-$F Horizontal position in steps of 1 dot 20 | \ $10 -$17 Horizontal position in steps of 16 dots 21 | \ $B2 $13 $5 0 4 $3c snd 22 | \ will position to third line ($B2), dot 53 ($13 = 3 x 16, $5 = 5, together 53). 23 | \ snd needs the number of display commands to be send, and the slave address. 24 | \ 53 2 pc will do the same. 25 | 26 | \ API: 27 | \ * I2ISR array, acts as an ISR "register file" 28 | \ - byte 0: ER < 0 indicates error (bits 6:0 copied from I2C_SR2) 29 | \ - byte 1: SA slave address (0..127) 30 | \ - byte 2: CCOUNT number of command bytes 31 | \ - byte 3: TCOUNT number of bytes in write phase 32 | \ - byte 4: RCOUNT number of bytes in read phase 33 | \ - byte 5,6 : CPOINT command buffer pointer 34 | \ - addr 7,8 : TPOINT transmit buffer pointer 35 | \ - addr 9,10: Receive buffer pointer 36 | 37 | MARK Mol 38 | 39 | $3c CONSTANT SSD \ slave address 40 | 41 | #require MARK 42 | #require DIA \ array with display initialisation commands 43 | #require I2ISR \ i2c interrupt service routine 44 | #require ]B? 45 | #require WIPE 46 | 47 | \ Temp. constants for I2ISR register access for user code 48 | I2ISR 2 + CONSTANT CCOUNT \ char number of command bytes 49 | I2ISR 3 + CONSTANT TCOUNT \ char number of bytes TX 50 | I2ISR 4 + CONSTANT RCOUNT \ char number of bytes RX 51 | I2ISR 5 + CONSTANT CPOINT \ points to command buffer 52 | I2ISR 7 + CONSTANT TPOINT \ points to TX buffer, starting with CMD/ADDR 53 | I2ISR 9 + CONSTANT RPOINT \ points to RX buffr 54 | 55 | NVM 56 | 57 | VARIABLE CREG 2 AlLOT \ command register 58 | VARIABLE LBF 4 ALLOT \ letter buffer, 6 bytes 59 | 60 | \ send n (1..4) bytes to slave a 61 | : snd ( b .. b b n a -- ) 62 | >R DUP CCOUNT C! 63 | 0 DO CREG I + C! LOOP 64 | CREG CPOINT ! 65 | R> I2S 66 | ; 67 | 68 | \ send n bytes @ a to display buffer 69 | : sb ( a n -- ) 70 | TCOUNT C! 71 | TPOINT ! 72 | $40 1 SSD snd 73 | ; 74 | 75 | \ Initialise display 76 | : ssdi ( --) 77 | i2i DIA TPOINT ! &26 TCOUNT C! 78 | 0 1 SSD snd 79 | ; 80 | 81 | \ Translates ASCII to address of bitpatterns: 82 | : a>bp ( c -- c-adr ) 83 | &32 MAX &127 MIN &32 - 5 * font + 84 | ; 85 | 86 | \ Display character: 87 | : drc ( c --) 88 | a>bp LBF 5 CMOVE 89 | LBF 6 sb 90 | ; 91 | 92 | \ spaces, just "00" @ $4100 93 | : spc ( u --) 94 | $4100 SWAP sb 95 | ; 96 | 97 | \ display a number. Beware that numbers are preceded with 1 space. 98 | \ To disable the preceding space: 99 | \ NVM $9D ' . &11 + $9D9D OVER ! 2+ C! \ $9D = NOP 100 | \ $9D ' U. 2+ $9D9D OVER ! 2+ C! RAM 101 | \ To revert to normal: 102 | \ NVM $77 ' . &11 + $CD89 OVER ! 2+ C! 103 | \ $77 ' U. 2 + $CD89 OVER ! 2+ C! RAM 104 | : d# ( n -- ) 105 | 'EMIT @ >R [ ' drc ] LITERAL 'EMIT ! 106 | . 107 | R> 'EMIT ! 108 | ; 109 | 110 | : dtxt 111 | 'EMIT @ >R [ ' drc ] LITERAL 'EMIT ! 112 | count 0 do dup c@ drc 1+ loop drop 113 | R> 'EMIT ! 114 | ; 115 | 116 | \ position cursor 117 | : pc ( column row -- ) 118 | $B0 + SWAP 119 | 16 /MOD 120 | $10 + 121 | 0 4 SSD snd 122 | ; 123 | 124 | \ clear screen 125 | : cls 126 | 8 0 DO $80 spc LOOP 127 | ; 128 | 129 | WIPE 130 | 131 | \\ 132 | 133 | \ display text compiled with $" 134 | : dtxt ( adr --) 135 | count 0 do dup c@ dup &32 = if 3 spc drop 136 | else drc 1 spc then 1+ loop drop 137 | ; 138 | 139 | \ display number 140 | : d# ( n --) dup abs <# #s swap sign #> 0 141 | do dup c@ drc 1 spc 1+ loop drop 142 | ; 143 | 144 | \ reset cursor 145 | : rc 146 | SSD 0 $10 $B0 0 4 snd 147 | ; 148 | 149 | \ clear screen 150 | : cls 151 | 8 0 DO $80 spc LOOP 152 | ; 153 | 154 | WIPE 155 | 156 | \\ 157 | 158 | : d# ( n -- ) 159 | 'EMIT @ >R [ ' drc ] LITERAL 'EMIT ! 160 | . 161 | R> 'EMIT ! 162 | ; 163 | 164 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # stm8-peripherals-forth 2 | 3 | This repository is based on https://github.com/TG9541/stm8ef . 4 | 5 | See the wiki for details 6 | -------------------------------------------------------------------------------- /RTC: -------------------------------------------------------------------------------- 1 | \ 515 bytes 2 | \ Real time clock modules DS1307 and DS3231, I2C communication 3 | \ DS3231 is much more accurate 4 | \ Both have 4kb eeprom, 128 pages of 32 bytes 5 | \ Registers 0:6 : BCD data for sec, min, hour, #day(1:7), date, month, year(0:99) 6 | 7 | MARK Mrtc 8 | #require I2ISR 9 | #require WIPE 10 | 11 | $68 CONSTANT RTC \ slave address clock 12 | $57 CONSTANT EEPROM \ eeprom slave address 13 | \ #require i2ci 14 | \ Temp. constants for I2ISR register access for user code 15 | I2ISR 2 + CONSTANT CCOUNT \ char number of command bytes 16 | I2ISR 3 + CONSTANT TCOUNT \ char number of bytes TX 17 | I2ISR 4 + CONSTANT RCOUNT \ char number of bytes RX 18 | I2ISR 5 + CONSTANT CPOINT \ points to command buffer 19 | I2ISR 7 + CONSTANT TPOINT \ points to TX buffer, starting with CMD/ADDR 20 | I2ISR 9 + CONSTANT RPOINT \ points to RX buffr 21 | 22 | NVM 23 | 24 | VARIABLE BFR $20 allot 25 | 26 | \ helper 27 | : hcl ( a a -- ) 28 | 7 SWAP C! 29 | BFR SWAP ! 30 | ; 31 | 32 | : RDC \ Read clock 33 | RPOINT RCOUNT hcl 34 | 0 1 RTC snd 35 | ; 36 | 37 | \ Set clock reg's 6:0, BCD input 38 | : SETC ( YY MM DD d hh mm ss) 39 | TPOINT TCOUNT hcl 40 | BFR 7 0 DO DUP ROT SWAP C! 1+ LOOP DROP 41 | 0 1 RTC snd 42 | ; 43 | 44 | : 2. 2 .R ; 45 | 46 | : ht 47 | HEX RDC 48 | BFR 2+ C@ $3F AND 2. ." : " BFR 1+ C@ 2. ." : " BFR C@ 2. 49 | ; 50 | 51 | : time 52 | CR BASE @ >r 53 | ht 54 | R> BASE ! 55 | ; 56 | 57 | \ time on OLED 58 | : >O 59 | [ ' drc ] LITERAL 'EMIT ! 60 | ; 61 | : >TX 62 | [ ' TX! ] LITERAL 'EMIT ! 63 | ; 64 | : TM 65 | >O 66 | ht 67 | >TX 68 | ; 69 | 70 | : hd 71 | RDC 72 | HEX BFR 4 + C@ 2. ." / " BFR 5 + C@ 2. ." '" BFR 6 + C@ 2. 73 | ; 74 | 75 | : date 76 | CR BASE @ >R 77 | hd 78 | R> BASE ! 79 | ; 80 | 81 | : dt 82 | >O 83 | hd 84 | >TX 85 | ; 86 | \ EEPROM words, slave address $57 87 | 88 | \ write n bytes from buffer to EEPROM 89 | : eew ( #byte #page buf-adr n --) 90 | TCOUNT C! 91 | TPOINT ! 92 | 2 EEPROM snd 93 | ; 94 | 95 | \ load buffer with n bytes from eeprom 96 | : eer ( #byte #page buf-adr n --) 97 | RCOUNT C! 98 | RPOINT ! 99 | 2 EEPROM snd 100 | ; 101 | 102 | \ background task: clock on oled display 103 | : BGT 104 | TIM &200 MOD 0= IF \ update every second 105 | &30 3 PC \ center cursor 106 | TM 107 | THEN 108 | ; 109 | 110 | WIPE 111 | 112 | \\ example 113 | 114 | \ set single clock register 115 | : SCRG ( b reg-adr --) 116 | rtc i2wb ( b reg-adr i2c-adr) 117 | ; 118 | 119 | hex 120 | 18 3 15 4 23 55 45 setc \ march 15 2018 23:55:45 121 | date time 122 | 5 11 scrg \ set clock reg. 5 (month) to 11 123 | 124 | Clock registers 0:6 125 | 0 sec 126 | 1 min 127 | 2 hr 128 | 3 #day (1-7) 129 | 4 day 130 | 5 month 131 | 6 year (0-99) 132 | 133 | Together with OLED: 134 | : txt $" This text to display" ; \ Compile text 135 | 0 8 ' txt 3 + DUP C@ eew \ write compiled text in page 8 of eeprom 136 | 0 8 bfR 21 eer \ read 20 bytes of page 8, start at 1ste position, from eeprom 137 | bfR dtxt \ display text on ssd1306 138 | 139 | -------------------------------------------------------------------------------- /]tx ( a n --) 176 | W_TX_PAYLOAD (nrf@!) 177 | 0 DO 178 | DUP C@ SPI DROP 1+ 179 | LOOP CS.H DROP 180 | CE.HD CE.L 181 | ; 182 | 183 | : rx>bd ( a -- n) \ copy rx-fifo to buffer at a, return payload width 184 | R_RX_PL_WID (nRF@!) $AB SPI SWAP OVER \ get payload width 185 | R_RX_PAYLOAD CS.H nSPI DROP 186 | 0 DO 187 | -1 SPI OVER C! 1+ 188 | LOOP CS.H 189 | DROP 190 | ; 191 | 192 | \ display nRF24 registers, two columns 193 | : regs ( --) 194 | CR ." 0 1" \ header 195 | BASE @ >R HEX 196 | $10 0 DO 197 | cr i DUP . nrf@1 5 .R 198 | i $10 + nrf@1 5 .R 199 | LOOP 200 | R> BASE ! 201 | ; 202 | 203 | : setAir ( ch pwr ar --) \ Set channel, power (0-3), air-rate (0-2) 204 | DUP IF 1- IF 8 ELSE 0 THEN 205 | ELSE DROP $20 206 | THEN SWAP 207 | 3 AND 1 sla OR R.RF_SETUP nrf!1 208 | R.RF_CH nrf!1 209 | ; 210 | 211 | \ helper word for spa, set 5 byte pipe address 212 | : hspa ( a1 a2 a3 a4 a5 p# --) 213 | R.RX_ADDR_P0 + BIT5 OR (nrf@!) 214 | 5 0 DO SPI DROP LOOP CS.H 215 | ; 216 | 217 | \ set address for pipe n 218 | \ Pipe 0 and 1: 5 byte address, the rest: one byte. 219 | \ address pipe 0 and tx-address should be the 220 | \ same for enhanced shockburst 221 | : spa ( msb...lsb n --) 222 | DUP 2 < IF 223 | 0= IF 224 | 5 0 DO 4 PICK LOOP \ dup address 225 | 0 hspa \ set address pipe 0 226 | 6 hspa \ set tx address 227 | ELSE 228 | 1 hspa 229 | THEN 230 | ELSE 231 | R.RX_ADDR_P0 + nRF!1 232 | THEN 233 | ; 234 | WIPE 235 | 236 | #require ]B! 237 | #require WIPE 238 | #require BUFFER 239 | #require TIB 240 | #require >IN 241 | #require #TIB 242 | #require 'EVAL 243 | #require TOKEN 244 | #require ACCEPT 245 | #require :NVM 246 | 247 | \res MCU: STM8S103 248 | \res export INT_EXTI2 EXTI_CR1 PC_CR2 PC_IDR 249 | 250 | \res MCU: nRF24L01 251 | \res export BIT5 BIT6 R.STATUS R.TX_ADDR R.SETUP_RETR 252 | \res export R.FEATURE R.DYNPD R.EN_RXADDR R_RX_PL_WID 253 | 254 | NVM 255 | 256 | #require EVALUATE 257 | 258 | \ time out 259 | : Tt ( dt t0 t1 -- f) 260 | - ABS < 261 | ; 262 | 263 | \ Receive payload, dynamic width, return payload width and status 264 | : PL.Rd ( a -- n s) \ stores n bytes in buff, n = actual payload width 265 | rx>bd 266 | BIT6 R.STATUS nRF!1s \ Write 1 to clear bit 267 | ; 268 | 269 | : PL.T ( a n -) \ transmit n bytes payload from a 270 | b>tx \ Send Loading tx buffer, drop status reply 271 | [ $7208 , $500B , $FB C, ] \ wait for PC4 IDR go low, TX_DS 272 | clI 273 | ; 274 | 275 | \ append c to mybuffer and transmit buffer if full 276 | : c>mb ( c --) 277 | mbi DUP @ DUP ( c a i i) &32 < IF 278 | 1 ROT +! mb + C! 279 | ELSE ( c a i) \ buffer full 280 | mb SWAP PL.T ( c a) \ transmit buffer 281 | 1 SWAP ! mb C! \ set mbi to 1, store c at index 0 282 | THEN 283 | ; 284 | 285 | : txtib ( -- ; text) \ transmit TIB, exit on empty input 286 | clI fRX sTX ce.l base @ hex 287 | CR ." : Tx to " R.TX_ADDR 5 nrf@n 288 | 5 0 DO . LOOP base ! 289 | BEGIN 290 | cr ." #:" 291 | sTX ce.l 292 | TIB $20 ACCEPT DUP IF 293 | [ 0 PC_CR2 4 ]B! \ PC4 interrupt disable 294 | PL.T 295 | [ 1 PC_CR2 4 ]B! \ PC4 interrupt enable 296 | sRX CE.H 297 | 20 TIM \ set time out 100 ms 298 | BEGIN 299 | 2DUP TIM Tt 300 | PC_IDR C@ NOT $10 AND \ IRQ (PC4) low 301 | OR 302 | UNTIL 2DROP 303 | 0 304 | ELSE 305 | 2DROP 1 306 | THEN 307 | UNTIL 308 | ; 309 | 310 | \ interrupt service routine: receive message, evaluate, send reply 311 | :NVM ( --) 312 | SAVEC [ 0 PC_CR2 4 ]B! \ PC4 interrupt disable 313 | PTX? @ IF 314 | BEGIN 315 | mb DUP PL.Rd >R 316 | type 317 | $E DUP R> AND = 318 | UNTIL 319 | clI \ reset RX_DR 320 | ELSE \ PRx 321 | mb DUP PL.Rd DROP 322 | 0 mbi ! 323 | sTX ce.l 324 | [ ' c>mb ] LITERAL 'EMIT ! \ pipe output for serial to c>mb 325 | EVALUATE 326 | mb mbi @ DUP IF PL.T ELSE 2DROP THEN 327 | [ ' TX! ] LITERAL 'EMIT ! \ reset emit vector 328 | sRX CE.H \ switch to listen mode, reset TX_DS 329 | THEN fTX [ 1 PC_CR2 4 ]B! \ PC4 interrupt enable 330 | IRET 331 | ;NVM INT_EXTI2 ! \ set Port C int vector (0x801E) 332 | 333 | 334 | : nRFi ( ch pwr ar --) \ init radio: channel, power (0-3), air-rate (0-2) 335 | sup \ set up pins 336 | CS.H 0 SPIon 337 | &10000 *10us \ delay after power-on reset (spec fig. 3) 338 | setair 339 | $3F R.EN_RXADDR nRF!1 \ auto acknowledgement for all pipes 340 | 4 R.FEATURE nRF!1 \ Set EN_DPL (enable dynamic payload) 341 | $3F R.DYNPD nrf!1 \ dynamic payload for all pipes 342 | fRX fTX clI \ flush registers, clear interrupts 343 | \ $13 R.SETUP_RETR nrf!1 \ 0.5 ms AutoRetransmitDelay 344 | $F 0 nrf!1 \ Power up as PRX 345 | [ $9b c, ] \ SIM, to enable EXTI_CRx setting 346 | [ 1 EXTI_CR1 5 ]B! \ Port C falling edge interrupt 347 | [ $9A c, ] \ RIM 348 | [ 1 PC_CR2 4 ]B! \ PC4 interrupt enable 349 | ; 350 | 351 | : start 352 | 100 3 1 nRFi \ channel 100, maximum power, 1 Mbps 353 | ; 354 | 355 | : rcv ( --) \ start receiving 356 | 0 PTX? ! 357 | sRX CE.H fTX 358 | ; 359 | 360 | : tmt ( --) \ start transmitting 361 | 1 PTX? ! 362 | txtib 363 | ; 364 | 365 | \ On PRX, to start communication on startup: NVM ' boot 'BOOT ! RAM 366 | : boot ( --) 367 | start rcv 368 | ; 369 | 370 | WIPE 371 | MARK NRF1 \ Mark end of nRF24 words 372 | 373 | \\ 374 | It is all a matter of timing. 375 | Set baudrate to 115200. This can be achieved by replacing the line 376 | LDW X,#0x6803 ; 9600 baud 377 | by 378 | LDW X,#0x080B ; 115200 baud 379 | in forth.asm before flashing the board. 380 | Or you could look for AE 11 06 in word COLD and replace it with AE 08 0B. 381 | ( in my micro's I did: NVM $80B $8147 ! RAM ) 382 | Don't forget to adjust e4thcom vocation ( -b B115200) 383 | With these settings I can send a complete flash dump. 384 | 385 | For a cheap way to improve the range, see: 386 | https://www.instructables.com/id/Enhanced-NRF24L01/ 387 | -------------------------------------------------------------------------------- /nRF-L: -------------------------------------------------------------------------------- 1 | \ nRF24L01+ remote console, dynamic payloads, enhanced shockburst 2 | \ Based on Richard's nRF24 library 3 | \ Set UART to 115200 baud, see remarks at the bottom. 4 | \ Communication is lost after "?" abort on PRX 5 | 6 | \ Led connected to PC4 / pin 20 7 | \ pin _IRQ on nRF24L01 connected to PB2 / pin 12 8 | \ pin _CE on nRF24L01 connected to PB3 / pin 13 9 | \ pin _CSN connected to PB4 / pin 14 10 | \ SCK = PB5 / pin 15 11 | \ MOSI = PB6 / pin 16 12 | \ MISO = PB6 / pin 17 13 | 14 | \ On PRX: boot 15 | \ On PTX: start tmt 16 | 17 | #require MARK 18 | MARK NRF0 \ Mark begin of nRF24 words 19 | 20 | #require WIPE 21 | 22 | NVM 23 | 24 | VARIABLE mb 31 ALLOT \ my buffer 25 | VARIABLE mbi \ buffer index 26 | VARIABLE PTX? \ Set role: 0 for remote device, 1 for console 27 | 28 | WIPE 29 | 30 | \res MCU: STM8L051 31 | \res export PB_ODR PB_DDR PB_CR1 PB_CR2 32 | \res export PC_CR1 PC_CR2 PC_DDR PC_ODR EXTI_CR1 33 | \res export SPI1_CR1 SPI1_CR2 SPI1_ICR 34 | \res export SPI1_SR SPI1_DR CLK_PCKENR1 35 | 36 | #require ]B! 37 | #require ]C! 38 | #require WIPE 39 | 40 | NVM 41 | 42 | #include hw/spi8l.fs 43 | 44 | : sup ( -- ) \ setup pins 45 | [ 1 PC_DDR 4 ]B! \ PC4 debug LED output 46 | [ 1 PC_CR1 4 ]B! \ set up as push pull 47 | [ $78 PB_DDR ]C! \ Port B setup nRF24L01 outputs 48 | [ $78 PB_CR1 ]C! \ set up as push pull outputs 49 | [ $78 PB_CR2 ]C! \ fast mode outputs 50 | ; 51 | 52 | : LOn [ 1 PC_ODR 4 ]B! ; \ LED on 53 | : LOff [ 0 PC_ODR 4 ]B! ; \ LED off 54 | 55 | : CE.L ( -- ) \ CE low 56 | [ 0 PB_ODR 3 ]B! 57 | ; 58 | 59 | : CE.H ( -- ) \ CE high 60 | [ 1 PB_ODR 3 ]B! 61 | ; 62 | 63 | : CS.L ( -- ) \ CS low 64 | [ 0 PB_ODR 4 ]B! 65 | ; 66 | 67 | : CS.H ( -- ) \ CS high 68 | [ 1 PB_ODR 4 ]B! 69 | ; 70 | 71 | : *10us ( n -- ) \ delay n * 10us 72 | 1- FOR [ 73 | $A62B , \ LD A,#42 74 | $4A C, \ 1$: DEC A 75 | $26FD , \ JRNE 1$ 76 | ] NEXT 77 | ; 78 | 79 | WIPE 80 | 81 | #require ]B! 82 | #require ]C! 83 | #require WIPE 84 | 85 | \res MCU: nRF24L01 86 | \res export BIT5 87 | \res export R.CONFIG R.SETUP_RETR R.RF_CH R.RF_SETUP 88 | \res export R.STATUS R.RX_ADDR_P0 R.TX_ADDR R.RX_PW_P0 89 | \res export R_RX_PAYLOAD W_TX_PAYLOAD W_ACK_PAYLOAD 90 | \res export FLUSH_TX FLUSH_RX 91 | \res export R.FEATURE R.DYNPD 92 | \res export R.EN_RXADDR NOP 93 | \res export R_RX_PL_WID R.FIFO_STATUS 94 | \res MCU: STM8L051 95 | \res export PB_IDR 96 | 97 | NVM 98 | 99 | \ shift left n bits 100 | : sla ( c n --- c) DUP 0= IF 101 | DROP ELSE 102 | 0 DO 2 * LOOP 103 | THEN 104 | ; 105 | 106 | \ talk to nRF24L01+ *************************************** 107 | 108 | : nSPI ( c -- s) 109 | CS.L SPI 110 | ; 111 | 112 | : (nrf@!) ( c1 -- ) 113 | nSPI DROP 114 | ; 115 | 116 | : nRF@1 ( c1 -- c2 ) \ fetch the contents of register c1 117 | (nrf@!) 0 SPI ( c2 ) 118 | CS.H 119 | ; 120 | 121 | : nRF@n ( a1 n --- cn....c1 ) \ read n bytes from nRF24 register a1 122 | SWAP (nRF@!) 123 | 0 DO $AA SPI LOOP 124 | CS.H 125 | ; 126 | 127 | : nRF!0 ( c1 -- ) \ send command c1 128 | nSPI CS.H DROP 129 | ; 130 | 131 | : nRF!1s ( c1 c2 -- s) \ write c1 to register c2 132 | $20 OR nSPI SWAP ( s c1 ) SPI DROP 133 | CS.H 134 | ; 135 | 136 | : nRF!1 ( c1 c2 -- ) \ write c1 to register c2 137 | nRF!1s DROP 138 | ; 139 | 140 | : R@Cg ( -- c1 ) \ fetch config reg 141 | R.CONFIG nRF@1 142 | ; 143 | 144 | : R!Cg ( c1 -- ) \ write C1 to config reg 145 | R.CONFIG nRF!1 146 | ; 147 | 148 | : fRX ( -- ) 149 | FLUSH_RX nRF!0 150 | ; 151 | 152 | : fTX ( -- ) 153 | FLUSH_TX nRF!0 154 | ; 155 | 156 | : clI ( -- ) \ clear all interrupts 157 | $70 R.STATUS nRF!1 \ 0b01110000 158 | ; 159 | 160 | : CE.HD ( -- ) \ set CE high and pause 161 | CE.H 1 *10us 162 | ; 163 | 164 | : sRX ( -- ) \ set as a receiver 165 | fRX R@Cg 1 OR R!Cg 166 | ; 167 | 168 | : sTX ( -- ) \ set as a transmitter 169 | fTX R@Cg $FE AND R!Cg 170 | ; 171 | 172 | \ copy c bytes from buffer at a to TX payload and send 173 | : b>tx ( a c --) 174 | W_TX_PAYLOAD (nrf@!) 175 | 0 DO 176 | DUP C@ SPI DROP 1+ 177 | LOOP CS.H DROP 178 | CE.HD CE.L 179 | ; 180 | 181 | : rx>bd ( a -- n) \ copy rx-fifo to buffer at a, return payload width 182 | R_RX_PL_WID (nRF@!) $AB SPI SWAP OVER \ get payload width 183 | CS.H R_RX_PAYLOAD nSPI DROP 184 | 0 DO 185 | -1 SPI OVER C! 1+ 186 | LOOP CS.H DROP 187 | ; 188 | 189 | \ display nRF24 registers, two columns 190 | : regs ( --) 191 | CR ." 0 1" \ header 192 | BASE @ >R HEX 193 | $10 0 DO 194 | cr i DUP . nrf@1 5 .R 195 | i $10 + nrf@1 5 .R 196 | LOOP 197 | R> BASE ! 198 | ; 199 | 200 | : setAir ( ch pwr ar --) \ channel, power (0-3), air-rate (0-2) 201 | DUP IF 1- IF 8 ELSE 0 THEN 202 | ELSE DROP $20 203 | THEN SWAP 204 | 3 AND 1 sla OR R.RF_SETUP nrf!1 205 | R.RF_CH nrf!1 206 | ; 207 | 208 | \ helper word for spa, set 5 byte pipe address 209 | : hspa ( a1 a2 a3 a4 a5 p# --) 210 | R.RX_ADDR_P0 + BIT5 OR (nrf@!) 211 | 5 0 DO SPI DROP LOOP CS.H 212 | ; 213 | 214 | \ set address for pipe n 215 | \ Pipe 0 and 1: 5 byte address, the rest: one byte. 216 | \ address pipe 0 and tx-address should be the 217 | \ same for enhanced shockburst 218 | : spa ( msb...lsb n --) 219 | DUP 2 < IF 220 | 0= IF 221 | 5 0 DO 4 PICK LOOP \ dup address 222 | 0 hspa \ set address pipe 0 223 | 6 hspa \ set tx address 224 | ELSE 225 | 1 hspa 226 | THEN 227 | ELSE 228 | R.RX_ADDR_P0 + nRF!1 229 | THEN 230 | ; 231 | 232 | WIPE 233 | 234 | #require ]B! 235 | #require WIPE 236 | #require BUFFER 237 | #require TIB 238 | #require >IN 239 | #require #TIB 240 | #require 'EVAL 241 | #require TOKEN 242 | #require ACCEPT 243 | #require :NVM 244 | 245 | \res MCU: nRF24L01 246 | \res export R.TX_ADDR R.FEATURE R.DYNPD R.SETUP_RETR R.FIFO_STATUS 247 | \res export R.EN_RXADDR BIT5 BIT6 R.STATUS 248 | \res MCU: STM8L051 249 | \res export INT_EXTI2 EXTI_CR1 PB_CR2 PB_IDR EXTI_SR1 PB_IDR 250 | 251 | NVM 252 | 253 | #require EVALUATE 254 | 255 | \ time out 256 | : Tt ( dt t0 t1 -- f) 257 | - ABS < 258 | ; 259 | 260 | \ Receive payload, dynamic width, return payload width and status 261 | : PL.Rd ( a -- n s) \ stores n bytes in buff, n = actual payload width 262 | rx>bd 263 | BIT6 R.STATUS nRF!1s \ Write 1 to clear bit 264 | ; 265 | 266 | : PL.T ( a n --) \ transmit n bytes payload from a 267 | b>tx \ Send Loading tx buffer, drop status reply 268 | [ $7204 , PB_IDR , $FB C, ] \ wait for Pb2 IDR go low, TX_DS 269 | clI 270 | ; 271 | 272 | : c>mb ( c --) \ append c to mybuffer and transmit buffer if full 273 | mbi DUP @ DUP ( c a i i) &32 < IF 274 | 1 ROT +! mb + C! 275 | ELSE ( c a i) \ buffer full 276 | mb swap PL.T ( c a) \ transmit buffer 277 | 1 SWAP ! mb C! \ set mbi to 1, store c at index 0 278 | THEN 279 | ; 280 | 281 | : txtib ( -- ; text) \ transmit TIB, exit on empty input 282 | \ usage: type message, , wait for reply, 283 | \ empty to exit 284 | clI fRX base @ hex 285 | CR ." : Tx to " R.TX_ADDR 5 nrf@n 286 | 5 0 DO . LOOP base ! 287 | BEGIN 288 | cr ." #:" 289 | sTX ce.l 290 | TIB $20 ACCEPT DUP IF 291 | [ 0 PB_CR2 2 ]B! \ PB2 interrupt disable 292 | PL.T 293 | [ 1 PB_CR2 2 ]B! \ PB2 interrupt enable 294 | sRX CE.H 295 | 20 TIM \ set time out 100 ms 296 | BEGIN 297 | 2DUP TIM TT \ time out? 298 | PB_IDR C@ NOT 4 AND \ IRQ (PB2) low 299 | OR 300 | UNTIL 2DROP 301 | 0 302 | ELSE 303 | 2DROP 1 304 | THEN 305 | UNTIL 306 | ; 307 | 308 | \ interrupt service routine: receive message, evaluate, send reply 309 | :NVM ( --) 310 | SAVEC 311 | PTX? @ IF 312 | BEGIN 313 | mb DUP PL.Rd >R 314 | type 315 | $E DUP R> AND = \ RX_FIFO empty 316 | UNTIL clI \ reset RX_DR 317 | ELSE \ PRx 318 | mb DUP PL.Rd DROP 319 | 0 mbi ! 320 | sTX ce.l 321 | [ ' c>mb ] LITERAL 'EMIT ! \ pipe output for serial to c>mb 322 | EVALUATE 323 | mb mbi @ DUP IF PL.T ELSE 2DROP THEN 324 | [ ' TX! ] LITERAL 'EMIT ! \ reset emit vector 325 | sRX CE.H \ switch to listen mode, reset TX_DS 326 | THEN fTX [ 1 EXTI_SR1 2 ]B! \ clear interrupt flag 327 | IRET 328 | ;NVM INT_EXTI2 ! \ set Port B2 int vector 329 | 330 | : nRFi ( ch pwr ar --) \ init radio: channel, power (0-3), air-rate (0-2) 331 | sup \ set up pins 332 | CS.H 0 SPIon \ initialise SPI 8 MHz 333 | &10000 *10us \ delay after power-on reset (spec fig. 3) 334 | setair 335 | $3F R.EN_RXADDR nRF!1 \ auto acknowledgement for all pipes 336 | 4 R.FEATURE nRF!1 \ Set EN_DPL (enable dynamic payload) 337 | $3F R.DYNPD nrf!1 \ dynamic payload for all pipes 338 | fRX fTX clI \ flush registers, clear interrupts 339 | \ $13 R.SETUP_RETR nrf!1 \ 0.5 ms AutoRetransmitDelay 340 | $F 0 nrf!1 \ Power up as PRX 341 | \ enable nRF24 IRQ interrupt of PB2 342 | [ $9b C, ] \ SIM, to enable EXTI_CRx setting 343 | [ 1 EXTI_CR1 5 ]B! \ IO-Port A/B/C/D-2 falling edge interrupt 344 | [ $9A C, ] \ RIM 345 | [ 1 PB_CR2 2 ]B! \ PB2 interrupt enable 346 | ; 347 | 348 | : start ( --) 349 | 100 3 1 nRFi \ channel 100, maximum power, 1 Mbps 350 | ; 351 | 352 | : rcv ( --) \ start receiving 353 | 0 PTX? ! 354 | sRX CE.H ftx 355 | ; 356 | 357 | : tmt ( --) \ start transmitting 358 | 1 PTX? ! 359 | sTX CE.L 360 | txtib 361 | ; 362 | 363 | \ to start communication on startup: NVM ' boot 'BOOT ! RAM 364 | : boot ( --) 365 | start rcv 366 | ; 367 | 368 | WIPE 369 | 370 | MARK NRF1 371 | 372 | \\ 373 | It is all a matter of timing. 374 | Set baudrate to 115200. This can be achieved by replacing the line 375 | LDW X,#0x6803 ; 9600 baud 376 | by 377 | LDW X,#0x080B ; 115200 baud 378 | in forth.asm before flashing the board. 379 | Or you could look for AE 11 06 in word COLD and replace it with AE 08 0B. 380 | ( in my micro's I did: NVM $80B $814F ! RAM ) 381 | Don't forget to adjust e4thcom vocation ( -b B115200) 382 | With these settings I can send a complete flash dump. 383 | 384 | For a cheap way to improve the range, see: 385 | https://www.instructables.com/id/Enhanced-NRF24L01/ 386 | 387 | -------------------------------------------------------------------------------- /nRF24L01.efr: -------------------------------------------------------------------------------- 1 | \ Bitmasks 2 | 01 equ BIT0 3 | 02 equ BIT1 4 | 04 equ BIT2 5 | 08 equ BIT3 6 | 10 equ BIT4 7 | 20 equ BIT5 8 | 40 equ BIT6 9 | 80 equ BIT7 10 | 11 | \ nrf24L01+ registers 12 | 00 equ R.CONFIG 13 | 01 equ R.EN_AA \ Enable ‘Auto Acknowledgment’ for pipe bit# 14 | 02 equ R.EN_RXADDR \ Enabled RX address (pipe) bit# 15 | 03 equ R.SETUP_AW 16 | 04 equ R.SETUP_RETR 17 | 05 equ R.RF_CH 18 | 06 equ R.RF_SETUP 19 | 07 equ R.STATUS 20 | 08 equ R.OBSERVE_TX 21 | 09 equ R.RPD \ Bit0: Received Power Detector 22 | 23 | 0A equ R.RX_ADDR_P0 24 | 0B equ R.RX_ADDR_P1 25 | 0C equ R.RX_ADDR_P2 26 | 0D equ R.RX_ADDR_P3 27 | 0E equ R.RX_ADDR_P4 28 | 0F equ R.RX_ADDR_P5 29 | 30 | 10 equ R.TX_ADDR 31 | 32 | 11 equ R.RX_PW_P0 \ number of bytes in RX payload in data pipe 0 33 | 12 equ R.RX_PW_P1 34 | 13 equ R.RX_PW_P2 35 | 14 equ R.RX_PW_P3 36 | 15 equ R.RX_PW_P4 37 | 16 equ R.RX_PW_P5 38 | 39 | 17 equ R.FIFO_STATUS 40 | 41 | 1C equ R.DYNPD \ Enable dynamic payload length for pipe bit# 42 | 1D equ R.FEATURE 43 | 44 | \ nrf24L01+ commands 45 | 00 equ R_REGISTER 46 | 20 equ W_REGISTER 47 | 60 equ R_RX_PL_WID 48 | 61 equ R_RX_PAYLOAD 49 | A0 equ W_TX_PAYLOAD 50 | A8 equ W_ACK_PAYLOAD \ %10101PPP, pipe PPP=0..5 51 | B0 equ W_TX_PAYLOAD_NOACK \ like W_TX_PAYLOAD but don't request ACK 52 | E1 equ FLUSH_TX 53 | E2 equ FLUSH_RX 54 | E3 equ REUSE_TX_PL 55 | FF equ NOP 56 | -------------------------------------------------------------------------------- /sdfat.fs: -------------------------------------------------------------------------------- 1 | \ SPI communication with SD FAT32 2 | \ #require sdinit.fs 3 | 4 | NVM 5 | 6 | #require D+ 7 | #require D= 8 | #require D> 9 | 10 | \ All sd variables Big Endian 11 | variable offh \ Start of Logical sectors, 12 | variable offl \ offset high and low 13 | \ physical addr = logical addr + offset 14 | variable spc \ Sectors per cluster 15 | variable rsec \ Reserved sectors 16 | variable fatlh \ FAT length: sectors/FAT 17 | variable fatll 18 | variable crds \ cardsize/(512*1024 bits) 19 | variable ssrdl \ Start sector of root directory 20 | variable ssrdh 21 | variable nfcl \ nexr free cluster, byte 492 of FS Info 22 | variable nfch 23 | variable lcll \ last cluster 24 | variable lclh 25 | 26 | : sdwt ( -- ) \ sd-wait 27 | begin $FF spi $FF = until 28 | ; 29 | 30 | : sdc ( u -- ) \ sd copy to buffer 31 | begin $ff spi $fe = until 32 | 0 do $FF SPI sdb I + c! loop 33 | spi> spi> 34 | ; 35 | 36 | : sdr ( ul uh -- ) \ read 512 bytes from phys. sector address 37 | &17 rot EXG rot EXG sd-cmd drop 38 | &512 sdc 39 | ; 40 | 41 | : sdw ( ul uh -- ) \ write buffer to phys. sector address 42 | &24 rot EXG rot EXG sd-cmd drop 43 | $FE >spi \ 44 | &512 0 do sdb i + c@ >spi loop 45 | $FF dup >spi >spi 46 | sdwt 47 | ; 48 | 49 | 50 | : gsdd ( -- ) \ Get SD Layout Data 51 | 9 0 0 sd-cmd drop &17 sdc 52 | sdb 8 + c@ $100 * 53 | sdb 9 + c@ 1+ + crds ! 54 | 0 0 sdr sdb &454 + dup \ Partition table 1 rel. sector 55 | @ EXG dup offl ! swap 56 | 2+ @ EXG dup offh ! 57 | sdr sdb dup &14 + @ EXG rsec ! ( sdb) 58 | dup &13 + C@ spc ! 59 | dup &36 + dup 60 | @ EXG dup fatll ! 2* rsec @ + >R 61 | 2+ @ EXG dup fatlh ! 2* R> swap 62 | offl @ offh @ D+ ssrdh ! ssrdl ! \ start sector root dir. 63 | offl @ 1+ offh @ sdr \ FSinfo sector 64 | &492 + dup @ EXG nfcl ! 65 | 2+ @ EXG nfch ! 66 | 67 | ; 68 | 69 | : c2s ( clsl clsh -- adrl adrh) \ Cluster# > Phys.Sector 70 | 2dup 0 0 D= if 71 | 2drop 2 0 then \ root cluster is 2 0 i.s.o. 0 0 72 | spc @ dup rot * 73 | rot 2- rot um* rot + 74 | ssrdl @ ssrdh @ D+ 75 | ; 76 | 77 | : dmpr ( -- ) \ Dump first sector of root dir. 78 | gsdd ssrdl @ ssrdh @ sdr sdb &511 dump 79 | ; 80 | 81 | \ Get FAT sector and index# from cluster#, 128 fat-rcrds/sector 82 | : fats ( clnl clnh -- i fatsl fatsh) 83 | 2dup 0 0 D= if 84 | 2drop 2 rsec @ offl @ + offh @ 85 | else 86 | &128 UM/MOD ( r q ) 0 swap ( r 0 q ) 87 | rsec @ + swap 88 | offl @ offh @ D+ ( r fatsl fatsh ) 89 | then 90 | ; 91 | 92 | 93 | \ Get FAT record plus index# from buffer 94 | : fatr ( i fatsl fatsh -- fatrl fatrh) 95 | sdr 96 | 4 * sdb + dup @ EXG 97 | swap 2 + @ EXG 98 | ; 99 | 100 | \ Write FAT record in buffer 101 | : fatw ( i fatrl fatrh -- ) \ 0 < i < 127 102 | exg swap exg swap rot 4 * sdb + 2! 103 | ; 104 | 105 | \ dump cluster (4096 bytes) 106 | : cdmp ( clustl clusth -- ) 107 | c2s 4 0 do 2dup i 0 D+ sdr 108 | >R >R sdb $1ff dump R> R> loop 2drop 109 | ; 110 | 111 | : gcl ( -- clnl clnh) \ Get cluster nummer from buffer 112 | sdb dup 113 | &26 + @ exg dup lcll ! swap 114 | &20 + @ exg dup lclh ! 115 | ; 116 | 117 | : clc ( scl sch -- i) \ file cluster count, max. 65535 118 | 0 >R 2dup begin 119 | R> 1+ >R fats fatr 120 | 2DUP $FFF7 $FF D> 121 | until 122 | 2drop c2s sdr R> \ restore buffer 123 | ; 124 | 125 | : ls 126 | gcl 2dup clc 0 do \ number of clusters of dir. 127 | c2s spc @ 0 do \ cycle through sectors of cluster 128 | 2dup sdr sdb ( d-sr ba) 129 | &16 0 do \ cycle through dir. entries of sector 130 | dup 2dup ( d-sr ba ba ba ba) 131 | c@ dup 0 = if ( d-sr ba ba ba b0) 132 | 2drop drop leave ( d-sr ba) 133 | then 134 | $e5 = if ( d-sr ba ba ba) \ deleted dir. entry 135 | 2drop 136 | else 137 | &11 + c@ dup ( d-sr ba ba b11 b11) 138 | $F = not if \ Long file name entry ( d-sr ba ba b11) 139 | $20 = if ( d-sr ba ba) 140 | cr &11 type 2 spaces ." f" 141 | else 142 | cr &11 type 2 spaces ." d" 143 | then 144 | else 145 | 2drop ( d-sr ba) 146 | then 147 | then 148 | $20 + 149 | loop 150 | drop 1 0 D+ ( d-sr) 151 | loop 152 | 2drop 153 | lcll @ lclh @ 154 | fats fatr 2dup lclh ! lcll ! ( d-cl) 155 | loop 2drop 156 | ; 157 | 158 | RAM 159 | 160 | -------------------------------------------------------------------------------- /sdinit.fs: -------------------------------------------------------------------------------- 1 | \ Initialise spi communication with sd card 2 | \ cs pin PA3 3 | 4 | RAM 5 | : _ ; 6 | 7 | #require MARKER 8 | #require ]B! 9 | 10 | #require spi.fs 11 | 12 | NVM 13 | variable sdb 511 allot \ data buffer, 512 bytes 14 | 15 | MARKER regs 16 | 17 | \res MCU: STM8S103 18 | \res export PA_ODR PA_DDR PA_CR1 PA_CR2 SPI_DR 19 | 20 | NVM 21 | 22 | : >SPI ( b -- ) SPI drop ; \ send byte, drop response 23 | : SPI> ( -- ) $FF >spi ; \ receive byte by generating 8 clocks 24 | 25 | : uss ( u -- ) 1 swap 0 do 2* loop drop ; \ delay 26 | 27 | : +spi ( -- ) [ 0 PA_ODR 3 ]B! ; \ select SPI 28 | : -spi ( -- ) [ 1 PA_ODR 3 ]B! ; \ deselect SPI 29 | 30 | : sd-cmd ( cmd argl argh -- u ) \ argl and argh Little Endian 31 | rot dup 8 = if 6 >R $87 >R \ SEND_IF_COND, 4 bytes 32 | else dup 58 = if 6 >R $FF >R \ Read OCR, 4 bytes 33 | else 2 >R $95 >R then then 34 | $ff >spi 35 | $40 or >spi 36 | dup >spi 37 | $100 / >spi 38 | dup >spi 39 | $100 / >spi 40 | R> >spi \ CRC 41 | 2 uss 42 | R> 0 do spi> loop 5 uss SPI_DR c@ 43 | ; 44 | 45 | : sdi \ initialise sd card and buffers 46 | [ 1 PA_DDR 3 ]B! \ cs pin PA3 output 47 | [ 1 PA_CR1 3 ]B! \ PA3 push/pull 48 | [ 1 PA_CR2 3 ]B! \ PA3 fast mode 49 | 5 SPIon \ spi slow 50 | -spi 10 0 do spi> loop 1 uss +spi \ Forse SPI mode 51 | 0 0 0 sd-cmd drop \ CMD0 go idle 52 | 8 $aa01 0 sd-cmd 53 | begin 55 0 0 sd-cmd drop 54 | 41 0 $40 sd-cmd 55 | 0= until 56 | drop 57 | 0 SPIon \ spi full speed 58 | ; 59 | 60 | regs 61 | 62 | --------------------------------------------------------------------------------