From 2f83a0bea9da444e3d70569eba3d6847ca02be03 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 21:59:17 +0200 Subject: ... --- forth/elegoo/depth.fs | 4 + forth/elegoo/elegoo.fs | 23 +++ forth/elegoo/fib.fs | 5 + forth/elegoo/flash-led.fs | 23 +++ forth/elegoo/main.fs | 34 ++++ forth/elegoo/rand.fs | 17 ++ forth/elegoo/uno.fs | 138 +++++++++++++ forth/flash-led.fs | 23 --- forth/forth/2literal.fs | 14 ++ forth/forth/avr/asm-examples.fs | 36 ++++ forth/forth/avr/asm.fs | 281 ++++++++++++++++++++++++++ forth/forth/avr/asm2.fs | 192 ++++++++++++++++++ forth/forth/avr/asm2test.fs | 32 +++ forth/forth/avr/asmtest.fs | 59 ++++++ forth/forth/avr/bit-test.fs | 58 ++++++ forth/forth/avr/bit.fs | 77 +++++++ forth/forth/avr/doloop.fs | 92 +++++++++ forth/forth/avr/i2c-base-avr.fs | 99 +++++++++ forth/forth/avr/i2c-ds1307.fs | 72 +++++++ forth/forth/avr/irqAtmega128.fs | 45 +++++ forth/forth/avr/irqAtmega2560.fs | 45 +++++ forth/forth/avr/irqAtmega328.fs | 42 ++++ forth/forth/avr/pick.fs | 6 + forth/forth/avr/see.fs | 77 +++++++ forth/forth/avr/task-test-arduino-mega2560.fs | 48 +++++ forth/forth/avr/task-test-arduino-uno.fs | 45 +++++ forth/forth/avr/task-test.fs | 45 +++++ forth/forth/avr/task.fs | 160 +++++++++++++++ forth/forth/avr/task2-test.fs | 47 +++++ forth/forth/avr/us.fs | 37 ++++ forth/forth/avr/xdump.fs | 45 +++++ forth/forth/case-test.fs | 23 +++ forth/forth/case.fs | 52 +++++ forth/forth/core.fs | 49 +++++ forth/forth/ct-test.fs | 22 ++ forth/forth/ct.fs | 40 ++++ forth/forth/doloop-test.fs | 32 +++ forth/forth/dump.fs | 26 +++ forth/forth/forget.fs | 18 ++ forth/forth/free.fs | 25 +++ forth/forth/help.fs | 68 +++++++ forth/forth/helpwords.fs | 255 +++++++++++++++++++++++ forth/forth/i2c-detect.fs | 54 +++++ forth/forth/jmptbl-test.fs | 70 +++++++ forth/forth/jmptbl.fs | 76 +++++++ forth/forth/jt-test.fs | 9 + forth/forth/jt.fs | 42 ++++ forth/forth/math.fs | 79 ++++++++ forth/forth/sieve.fs | 43 ++++ forth/forth/sieve2.fs | 59 ++++++ forth/forth/tc74-app.fs | 40 ++++ forth/forth/vt100-test.fs | 36 ++++ forth/forth/vt100.fs | 55 +++++ forth/main.fs | 34 ---- forth/see.fs | 77 ------- 55 files changed, 3071 insertions(+), 134 deletions(-) create mode 100644 forth/elegoo/depth.fs create mode 100644 forth/elegoo/elegoo.fs create mode 100644 forth/elegoo/fib.fs create mode 100644 forth/elegoo/flash-led.fs create mode 100644 forth/elegoo/main.fs create mode 100644 forth/elegoo/rand.fs create mode 100644 forth/elegoo/uno.fs delete mode 100644 forth/flash-led.fs create mode 100644 forth/forth/2literal.fs create mode 100644 forth/forth/avr/asm-examples.fs create mode 100644 forth/forth/avr/asm.fs create mode 100644 forth/forth/avr/asm2.fs create mode 100644 forth/forth/avr/asm2test.fs create mode 100644 forth/forth/avr/asmtest.fs create mode 100644 forth/forth/avr/bit-test.fs create mode 100644 forth/forth/avr/bit.fs create mode 100644 forth/forth/avr/doloop.fs create mode 100644 forth/forth/avr/i2c-base-avr.fs create mode 100644 forth/forth/avr/i2c-ds1307.fs create mode 100644 forth/forth/avr/irqAtmega128.fs create mode 100644 forth/forth/avr/irqAtmega2560.fs create mode 100644 forth/forth/avr/irqAtmega328.fs create mode 100644 forth/forth/avr/pick.fs create mode 100644 forth/forth/avr/see.fs create mode 100644 forth/forth/avr/task-test-arduino-mega2560.fs create mode 100644 forth/forth/avr/task-test-arduino-uno.fs create mode 100644 forth/forth/avr/task-test.fs create mode 100644 forth/forth/avr/task.fs create mode 100644 forth/forth/avr/task2-test.fs create mode 100644 forth/forth/avr/us.fs create mode 100644 forth/forth/avr/xdump.fs create mode 100644 forth/forth/case-test.fs create mode 100644 forth/forth/case.fs create mode 100644 forth/forth/core.fs create mode 100644 forth/forth/ct-test.fs create mode 100644 forth/forth/ct.fs create mode 100644 forth/forth/doloop-test.fs create mode 100644 forth/forth/dump.fs create mode 100644 forth/forth/forget.fs create mode 100644 forth/forth/free.fs create mode 100644 forth/forth/help.fs create mode 100644 forth/forth/helpwords.fs create mode 100644 forth/forth/i2c-detect.fs create mode 100644 forth/forth/jmptbl-test.fs create mode 100644 forth/forth/jmptbl.fs create mode 100644 forth/forth/jt-test.fs create mode 100644 forth/forth/jt.fs create mode 100644 forth/forth/math.fs create mode 100644 forth/forth/sieve.fs create mode 100644 forth/forth/sieve2.fs create mode 100644 forth/forth/tc74-app.fs create mode 100644 forth/forth/vt100-test.fs create mode 100644 forth/forth/vt100.fs delete mode 100644 forth/main.fs delete mode 100644 forth/see.fs diff --git a/forth/elegoo/depth.fs b/forth/elegoo/depth.fs new file mode 100644 index 0000000..b4bb661 --- /dev/null +++ b/forth/elegoo/depth.fs @@ -0,0 +1,4 @@ +-depth +marker -depth + +: depth s0 @ 2- sp@ - 2/ ; diff --git a/forth/elegoo/elegoo.fs b/forth/elegoo/elegoo.fs new file mode 100644 index 0000000..f6d5391 --- /dev/null +++ b/forth/elegoo/elegoo.fs @@ -0,0 +1,23 @@ +-pwm +marker -pwm + +$2a constant ddrd +$44 constant tccr0a +$45 constant tccr0b +$47 constant ocr0a +$48 constant ocr0b + +: timer0init + #01100000 ddrd mset \ output PD6 PD5 + #10100011 tccr0a c! \ mode3: non-inverted pwm A and B + #00000101 tccr0b c! \ prescale/1024 +; + +: setA ocr0a c! ; +: setB ocr0b c! ; + +: go + timer0init + $1f setA + $3f setB +; diff --git a/forth/elegoo/fib.fs b/forth/elegoo/fib.fs new file mode 100644 index 0000000..8f4cfbc --- /dev/null +++ b/forth/elegoo/fib.fs @@ -0,0 +1,5 @@ +-fib +marker fib + +: fib ( n -- fib ) + 0 1 rot 0 ?do over + swap loop drop ; diff --git a/forth/elegoo/flash-led.fs b/forth/elegoo/flash-led.fs new file mode 100644 index 0000000..08fc643 --- /dev/null +++ b/forth/elegoo/flash-led.fs @@ -0,0 +1,23 @@ +-flash-led-avr +marker -flash-led-avr +\ PB5 is Arduino digital pin 13. + +$0023 constant pinb +$0024 constant ddrb +$0025 constant portb + +$0026 constant pinc +$0027 constant ddrc +$0028 constant portc + +$0029 constant pind +$002a constant ddrd +$002b constant portd + +1 #5 lshift constant bit5 + +: init bit5 ddrb mset ; \ set pin as output +: do_output portb c@ bit5 xor portb c! ; \ toggle the bit +: main init begin do_output #500 ms again ; + +main diff --git a/forth/elegoo/main.fs b/forth/elegoo/main.fs new file mode 100644 index 0000000..bfbf81e --- /dev/null +++ b/forth/elegoo/main.fs @@ -0,0 +1,34 @@ +-io +marker -io \ define ports + +$0023 constant PB +$0023 constant pinb +$0024 constant ddrb +$0025 constant portb + +$0026 constant PC +$0026 constant pinc +$0027 constant ddrc +$0028 constant portc + +$0029 constant PD +$0029 constant pind +$002a constant ddrd +$002b constant portd + +-init +marker init + +: bv ( bit -- mask ) 1 swap lshift ; +: pin ( bit base-addr -- ) bv swap 2dup 1+ mclr ; +: port ( bit base-addr -- ) bv swap 1+ 2dup mset 1+ ; +: set ( mask addr -- ) mset ; +: clr ( mask addr -- ) mclr ; +: init + PB #3 port 2constant servo + PB #5 port 2constant led + PD #2 pin 2constant sr + PD #3 pin 2constant sc + PD #4 pin 2constant sl +; +: get ( mask addr -- bool ) c@ invert and 0= ; diff --git a/forth/elegoo/rand.fs b/forth/elegoo/rand.fs new file mode 100644 index 0000000..2bd2447 --- /dev/null +++ b/forth/elegoo/rand.fs @@ -0,0 +1,17 @@ +\ Fast Random Number Generator algorithm by George Marsaglia "Xorshift RNGs" + +-rnd +marker -rnd + +: xorshift ( n -- n ) + dup #13 lshift xor + dup #17 rshift xor + dup #5 lshift xor +; + +variable (rnd) \ seed +ticks (rnd) ! \ initialize seed + +: rnd ( -- n ) + (rnd) @ xorshift dup (rnd) ! +; diff --git a/forth/elegoo/uno.fs b/forth/elegoo/uno.fs new file mode 100644 index 0000000..bd70aa3 --- /dev/null +++ b/forth/elegoo/uno.fs @@ -0,0 +1,138 @@ +-uno +marker -uno + +\ USART0 +$c6 constant UDR0 \ USART I/O Data Register +$c0 constant UCSR0A \ USART Control and Status Register A +$c1 constant UCSR0B \ USART Control and Status Register B +$c2 constant UCSR0C \ USART Control and Status Register C +$c4 constant UBRR0 \ USART Baud Rate Register Bytes + +\ TWI +$bd constant TWAMR \ TWI (Slave) Address Mask Register +$b8 constant TWBR \ TWI Bit Rate register +$bc constant TWCR \ TWI Control Register +$b9 constant TWSR \ TWI Status Register +$bb constant TWDR \ TWI Data register +$ba constant TWAR \ TWI (Slave) Address register + +\ TIMER_COUNTER_1 +$6f constant TIMSK1 \ Timer/Counter Interrupt Mask Register +$36 constant TIFR1 \ Timer/Counter Interrupt Flag register +$80 constant TCCR1A \ Timer/Counter1 Control Register A +$81 constant TCCR1B \ Timer/Counter1 Control Register B +$82 constant TCCR1C \ Timer/Counter1 Control Register C +$84 constant TCNT1 \ Timer/Counter1 Bytes +$88 constant OCR1A \ Timer/Counter1 Output Compare Register Bytes +$8a constant OCR1B \ Timer/Counter1 Output Compare Register Bytes +$86 constant ICR1 \ Timer/Counter1 Input Capture Register Bytes +$43 constant GTCCR \ General Timer/Counter Control Register + +\ TIMER_COUNTER_2 +$70 constant TIMSK2 \ Timer/Counter Interrupt Mask register +$37 constant TIFR2 \ Timer/Counter Interrupt Flag Register +$b0 constant TCCR2A \ Timer/Counter2 Control Register A +$b1 constant TCCR2B \ Timer/Counter2 Control Register B +$b2 constant TCNT2 \ Timer/Counter2 +$b4 constant OCR2B \ Timer/Counter2 Output Compare Register B +$b3 constant OCR2A \ Timer/Counter2 Output Compare Register A +$b6 constant ASSR \ Asynchronous Status Register + +\ AD_CONVERTER +$7c constant ADMUX \ The ADC multiplexer Selection Register +$78 constant ADC \ ADC Data Register Bytes +$7a constant ADCSRA \ The ADC Control and Status register A +$7b constant ADCSRB \ The ADC Control and Status register B +$7e constant DIDR0 \ Digital Input Disable Register + +\ ANALOG_COMPARATOR +$50 constant ACSR \ Analog Comparator Control And Status Register +$7f constant DIDR1 \ Digital Input Disable Register 0x1 + +\ PORTB +$25 constant PORTB \ Port B Data Register +$24 constant DDRB \ Port B Data Direction Register +$23 constant PINB \ Port B Input Pins + +\ PORTC +$28 constant PORTC \ Port C Data Register +$27 constant DDRC \ Port C Data Direction Register +$26 constant PINC \ Port C Input Pins + +\ PORTD +$2b constant PORTD \ Port D Data Register +$2a constant DDRD \ Port D Data Direction Register +$29 constant PIND \ Port D Input Pins + +\ TIMER_COUNTER_0 +$48 constant OCR0B \ Timer/Counter0 Output Compare Register +$47 constant OCR0A \ Timer/Counter0 Output Compare Register +$46 constant TCNT0 \ Timer/Counter0 +$45 constant TCCR0B \ Timer/Counter Control Register B +$44 constant TCCR0A \ Timer/Counter Control Register A +$6e constant TIMSK0 \ Timer/Counter0 Interrupt Mask Register +$35 constant TIFR0 \ Timer/Counter0 Interrupt Flag register + +\ EXTERNAL_INTERRUPT +$69 constant EICRA \ External Interrupt Control Register +$3d constant EIMSK \ External Interrupt Mask Register +$3c constant EIFR \ External Interrupt Flag Register +$68 constant PCICR \ Pin Change Interrupt Control Register +$6d constant PCMSK2 \ Pin Change Mask Register 0x2 +$6c constant PCMSK1 \ Pin Change Mask Register 0x1 +$6b constant PCMSK0 \ Pin Change Mask Register 0x0 +$3b constant PCIFR \ Pin Change Interrupt Flag Register + +\ SPI +$4e constant SPDR \ SPI Data Register +$4d constant SPSR \ SPI Status Register +$4c constant SPCR \ SPI Control Register + +\ WATCHDOG +$60 constant WDTCSR \ Watchdog Timer Control Register + +\ CPU +$64 constant PRR \ Power Reduction Register +$66 constant OSCCAL \ Oscillator Calibration Value +$61 constant CLKPR \ Clock Prescale Register +$5F constant SREG \ Status Register +$5d constant SP \ Stack Pointer +$57 constant SPMCSR \ Store Program Memory Control and Status Register +$55 constant MCUCR \ MCU Control Register +$54 constant MCUSR \ MCU Status Register +$53 constant SMCR \ Sleep Mode Control Register +$4b constant GPIOR2 \ General Purpose I/O Register 0x2 +$4a constant GPIOR1 \ General Purpose I/O Register 0x1 +$3e constant GPIOR0 \ General Purpose I/O Register 0x0 + +\ EEPROM +$41 constant EEAR \ EEPROM Address Register Bytes +$40 constant EEDR \ EEPROM Data Register +$3f constant EECR \ EEPROM Control Register + +\ Interrupts +$02 constant INT0Addr \ External Interrupt Request 0x0 +$04 constant INT1Addr \ External Interrupt Request 0x1 +$06 constant PCINT0Addr \ Pin Change Interrupt Request 0x0 +$08 constant PCINT1Addr \ Pin Change Interrupt Request 0x0 +$0a constant PCINT2Addr \ Pin Change Interrupt Request 0x1 +$0c constant WDTAddr \ Watchdog Time-out Interrupt +$0e constant TIMER2_COMPAAddr \ Timer/Counter2 Compare Match A +$10 constant TIMER2_COMPBAddr \ Timer/Counter2 Compare Match A +$12 constant TIMER2_OVFAddr \ Timer/Counter2 Overflow +$14 constant TIMER1_CAPTAddr \ Timer/Counter1 Capture Event +$16 constant TIMER1_COMPAAddr \ Timer/Counter1 Compare Match A +$18 constant TIMER1_COMPBAddr \ Timer/Counter1 Compare Match B +$1a constant TIMER1_OVFAddr \ Timer/Counter1 Overflow +$1c constant TIMER0_COMPAAddr \ TimerCounter0 Compare Match A +$1e constant TIMER0_COMPBAddr \ TimerCounter0 Compare Match B +$20 constant TIMER0_OVFAddr \ Timer/Couner0 Overflow +$22 constant SPI_STCAddr \ SPI Serial Transfer Complete +$24 constant USART_RXAddr \ USART Rx Complete +$26 constant USART_UDREAddr \ USART, Data Register Empty +$28 constant USART_TXAddr \ USART Tx Complete +$2a constant ADCAddr \ ADC Conversion Complete +$2c constant EE_READYAddr \ EEPROM Ready +$2e constant ANALOG_COMPAddr \ Analog Comparator +$30 constant TWIAddr \ Two-wire Serial Interface +$32 constant SPM_ReadyAddr \ Store Program Memory Read diff --git a/forth/flash-led.fs b/forth/flash-led.fs deleted file mode 100644 index 08fc643..0000000 --- a/forth/flash-led.fs +++ /dev/null @@ -1,23 +0,0 @@ --flash-led-avr -marker -flash-led-avr -\ PB5 is Arduino digital pin 13. - -$0023 constant pinb -$0024 constant ddrb -$0025 constant portb - -$0026 constant pinc -$0027 constant ddrc -$0028 constant portc - -$0029 constant pind -$002a constant ddrd -$002b constant portd - -1 #5 lshift constant bit5 - -: init bit5 ddrb mset ; \ set pin as output -: do_output portb c@ bit5 xor portb c! ; \ toggle the bit -: main init begin do_output #500 ms again ; - -main diff --git a/forth/forth/2literal.fs b/forth/forth/2literal.fs new file mode 100644 index 0000000..27cb1ef --- /dev/null +++ b/forth/forth/2literal.fs @@ -0,0 +1,14 @@ +\ ******************************************************************* +\ * +\ Filename: 2literal.txt * +\ Date: 21.03.2013 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* + +: 2literal ( x x -- ) + swap postpone literal postpone literal postpone ; immediate + diff --git a/forth/forth/avr/asm-examples.fs b/forth/forth/avr/asm-examples.fs new file mode 100644 index 0000000..5765ee2 --- /dev/null +++ b/forth/forth/avr/asm-examples.fs @@ -0,0 +1,36 @@ +\ needs asm.txt + +-asmexamples +marker -asmexamples + +\ Top of stack is always cached in R24:R25 + +\ duplicate top of stack +\ identical to DUP on FlashForth +: _dup ( n -- n n ) + [ R25 -Y st, ] + [ R24 -Y st, ] +; inlined + +\ drop top of stack +\ identical to DROP on FlashForth +: _drop ( n -- ) + [ R24 Y+ ld, ] + [ R25 Y+ ld, ] +; inlined + +\ Load constant $1234 to top of stack +: a-number ( -- 1234 ) + dup \ Make space for new TOS value + [ R24 $34 ldi, ] + [ R25 $12 ldi, ] +; + +\ Pop the top of stack to registers R18:R19 +\ R18 and R19 are free to use unless DO..LOOP is used +: tos-to-r18-r19 ( n -- ) + [ R18 R24 movw, ] \ Move TOS to R18:R19 + drop \ load R24:R25 with new TOS +; + + diff --git a/forth/forth/avr/asm.fs b/forth/forth/avr/asm.fs new file mode 100644 index 0000000..1ddebd0 --- /dev/null +++ b/forth/forth/avr/asm.fs @@ -0,0 +1,281 @@ +\ ********************************************************************* +\ Filename: asm.txt * +\ Date: 03.02.2014 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ FlashForth assembler for Atmega chips +-as +marker -as +hex + +\ Combine the opcode with the operand fields +: mask! ( dest1 opcode mask -- instruction ) + rot over invert and rot rot and or ; \ dest1&!mask src&mask or + +\ Fetch src and mask from addr and append to dictinary via mask +: mask, ( dest1 addr -- ) + 2@ swap mask! i, ; + +\ Create name and data fields for opcode and mask in flash +: create,, flash create , , ram ; + +: Rd,Rr: ( Rd Rr opcode mask -- xxxz.xxrd.dddd.rrrr ) + create,, + does> >r + $1f and dup $5 lshift or $20f and \ -- Rd r00000rrrr + swap $4 lshift $1f0 and \ -- rr 0ddddd0000 + or r> 2@ mask! \ -- ddrr opcode mask mask! + dup $fc07 and $9000 = + if $efff and then i, ; \ if Z or Y then z=0 + +: Rd: ( Rd opcode mask -- xxxx.xxxd.dddd.xxxx ) + create,, + does> >r + $4 lshift $1f0 and \ -- 0ddddd0000 + r> mask, ; + + \ Operands Rd,constant 8bit +: Rd,k: ( Rd k8 opcode mask -- xxxx.kkkk.dddd.kkkk ) + create,, + does> >r + $ff and dup $4 lshift or $f0f and \ -- Rd kkkk0000kkkk + swap $4 lshift $f0 and \ -- kk dddd0000 + or r> mask, ; \ kkdd opcode mask mask! to flash + +\ Operands Rd,Rr,constant 6bit +: Rd,Rr+q: ( Rd Rr k6 opcode mask -- xxkx.kkxd.dddd.rkkk ) + create,, + does> >r + $3f and dup $7 lshift \ -- Rd Rr k6 xkkkkkkxxxxxxx + dup $1000 and $1 lshift or or $2c07 and \ -- Rd Rr kxkkxxxxxxxkkk + rot $4 lshift $1f0 and \ -- Rr kk ddddd0000 + or swap 8 and \ -- kkdd rxxx + or r> mask, ; \ kkddrr opcode mask mask! to flash + + +\ Operands Rw pair,constant 6bit +: Rw,k: ( Rw k6 opcode mask -- xxxx.xxxx.kkww.kkkk ) + create,, + does> >r + $3f and dup $2 lshift $c0 and \ -- Rw k6 kk000000 + swap $f and or \ -- Rw kk00kkkk + swap $4 lshift $30 and \ -- kk ww0000 + or r> mask, ; \ kkww opcode mask mask! to flash + +\ Operands P-port,bit +: P,b: ( P b opcode mask -- xxxx.xxxx.PPPP.Pbbb ) + create,, + does> >r + $7 and swap $3 lshift \ -- 0bbb PPPPP000 + or r> mask, ; \ PPbb opcode mask mask! to flash + +\ Operands Rd,P-port +: Rd,P: ( Rd P opcode mask -- xxxx.xPPd.dddd.PPPP ) + create,, + does> >r + $3f and dup $5 lshift or $60f and \ -- Rd PP00000PPPP + swap $4 lshift $1f0 and \ -- PP 00ddddd0000 + or r> mask, ; \ ddPP opcode mask mask! to flash + + +\ Operand k16 k6 +: k22: ( k16 k6 opcode mask -- k16 xxxx.xxxk.kkkk.xxxk ) + create,, + does> >r + dup $1 and swap $3 lshift \ -- 000k kkkkkk000 + or r> mask, i, ; \ k16 kk opcode mask mask! to flash + +\ Opcode only to flash +: op: ( opcode -- ) + flash create , ram does> @ i, ; + + +0100 ff00 Rd,Rr: movw_ +: movw, 1 rshift swap \ R0:1,R2:3,R4:5,..R30:31 + 1 rshift swap \ 0 2 movw, R0:1<--R2:3 + movw_ ; \ Rd Rr -- +9c00 fc00 Rd,Rr: mul, \ Rd Rr -- +0200 ff00 Rd,Rr: muls, \ Rd Rr -- +0300 ff88 Rd,Rr: mulsu, \ Rd Rr -- +0308 ff88 Rd,Rr: fmul, \ Rd Rr -- +0380 ff88 Rd,Rr: fmuls, \ Rd Rr -- +0388 ff88 Rd,Rr: fmulsu, \ Rd Rr -- +0400 fc00 Rd,Rr: cpc, \ Rd Rr -- +0800 fc00 Rd,Rr: sbc, \ Rd Rr -- +0c00 fc00 Rd,Rr: add, \ Rd Rr -- +1000 fc00 Rd,Rr: cpse, \ Rd Rr -- +1400 fc00 Rd,Rr: cp, \ Rd Rr -- +1800 fc00 Rd,Rr: sub, \ Rd Rr -- +1c00 fc00 Rd,Rr: adc, \ Rd Rr -- +2000 fc00 Rd,Rr: and, \ Rd Rr -- +2400 fc00 Rd,Rr: eor, \ Rd Rr -- +2800 fc00 Rd,Rr: or, \ Rd Rr -- +2c00 fc00 Rd,Rr: mov, \ Rd Rr -- + +3000 f000 Rd,k: cpi, \ Rd k -- +4000 f000 Rd,k: sbci, \ Rd k -- +5000 f000 Rd,k: subi, \ Rd k -- +6000 f000 Rd,k: ori, \ Rd k -- +: sbr, ori, ; \ Rd k -- +7000 f000 Rd,k: andi, \ Rd k -- +: cbr, invert andi, ; +e000 f000 Rd,k: ldi, + + +8000 d200 Rd,Rr+q: ldd, ( Rd Rr q -- ) \ Rr={Z+,Y+}, 2 Y+ 3F ldd, +8200 d200 Rd,Rr+q: std, ( Rr Rd q -- ) \ Rd={Z+,Y+}, Y+ 3F 2 std, + +9000 fe00 Rd,Rr: ld, ( Rd Rr -- ) \ Rr={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z} +9000 fe0f Rd: lds_ +: lds, swap lds_ i, ; \ Rd k16 -- ) + +9004 fe0f Rd,Rr: lpm, ( Rd Rr -- ) \ Rr={Z,Z+}, 2 Z+ lpm, +9006 fe0e Rd,Rr: elpm, ( Rd Rr -- ) \ Rr={Z,Z+} +9200 fe00 Rd,Rr: st, ( Rr Rd -- ) \ Rd={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z} + +9200 fe0f Rd: sts_ +: sts, sts_ i, ; ( k16 Rd -- ) \ FFFF 2 sts, adr(FFFF)<--R2 + +: lsl, dup add, ; \ Rd -- +: rol, dup adc, ; \ Rd -- +: tst, dup and, ; \ Rd -- +: clr, dup eor, ; \ Rd -- +: ser, $ff ldi, ; \ Rd -- + +900f fe0f Rd: pop, \ Rd -- +920f fe0f Rd: push, \ Rd -- +9400 fe0f Rd: com, \ Rd -- +9401 fe0f Rd: neg, \ Rd -- +9402 fe0f Rd: swap, \ Rd -- +9403 fe0f Rd: inc, \ Rd -- +9405 fe0f Rd: asr, \ Rd -- +9406 fe0f Rd: lsr, \ Rd -- +9407 fe0f Rd: ror, \ Rd -- +9408 ff8f Rd: bset, \ Rd -- +9488 ff8f Rd: bclr, \ Rd -- +940a fe0f Rd: dec, \ Rd -- + +0000 op: nop, \ -- +9508 op: ret, \ -- +9518 op: reti, \ -- +9588 op: sleep, \ -- +9598 op: break, \ -- +95a8 op: wdr, \ -- +9409 op: ijmp, \ -- +9419 op: eijmp, \ -- +9509 op: icall, \ -- +9519 op: eicall, \ -- + +9488 op: clc, \ -- +94d8 op: clh, \ -- +94d8 op: cli, \ -- +94a8 op: cln, \ -- +94c8 op: cls, \ -- +94e8 op: clt, \ -- +94b8 op: clv, \ -- +9498 op: clz, \ -- +9408 op: sec, \ -- +9458 op: seh, \ -- +9478 op: sei, \ -- +9428 op: sen, \ -- +9448 op: ses, \ -- +9468 op: set, \ -- +9438 op: sev, \ -- +9418 op: sez, \ -- + +9600 ff00 Rw,k: adiw, ( Rw k6 -- ) \ 3 3F adiw, ZLH=ZLH+#3F +9700 ff00 Rw,k: sbiw, +9800 ff00 P,b: cbi, \ P b -- +9900 ff00 P,b: sbic, \ P b -- +9a00 ff00 P,b: sbi, \ P b -- +9b00 ff00 P,b: sbis, \ P b -- + +b000 f800 Rd,P: inn, \ Rd P -- +b800 f800 Rd,P: out, \ Rr P -- + +f800 fe08 Rd,Rr: bld, \ Rd b -- +fa00 fe08 Rd,Rr: bst, \ Rd b -- +fc00 fe08 Rd,Rr: sbrc, \ Rd b -- +fe00 fe08 Rd,Rr: sbrs, \ Rd b -- + +940c fe0e k22: jmp, ( k16 k6 -- ) \ k6=0 for 16b addr +940e fe0e k22: call, ( k16 k6 -- ) \ k6=0 for 16b addr +: rjmp, c000 f000 mask! i, ; ( k12 -- ) +: rcall, d000 f000 mask! i, ; ( k12 -- ) + + +f008 constant cs, \ if/until carry set +f008 constant lo, \ if/until lower +f009 constant eq, \ if/until zero +f00a constant mi, \ if/until negative +f00b constant vs, \ if/until no overflow +f00c constant lt, \ if/until less than +f00d constant hs, \ if/until half carry set +f00e constant ts, \ if/until T flag set +f00f constant ie, \ if/until interrupt enabled + +: not, 0400 xor ; \ Invert the condition code + +: if, ( cc -- addr) i, [ ' if #8 + pfl - zfl d2/ jmp, ] ; +: else, postpone else ; +: then, postpone then ; +: begin, postpone begin ; +: until, ( addr cc -- ) i, postpone again ; +: again, ( addr -- ) postpone again ; + +$00 constant Z +$01 constant Z+ +$02 constant -Z +$08 constant Y +$09 constant Y+ +$0a constant -Y +$0c constant X +$0d constant X+ +$0e constant -X + +00 constant R0 +01 constant R1 +02 constant R2 +03 constant R3 +04 constant R4 +05 constant R5 +06 constant R6 +07 constant R7 +08 constant R8 +09 constant R9 +0a constant R10 +0b constant R11 +0c constant R12 +0d constant R13 +0e constant R14 +0f constant R15 +10 constant R16 +11 constant R17 +12 constant R18 +13 constant R19 +14 constant R20 +15 constant R21 +16 constant R22 +17 constant R23 +18 constant R24 +19 constant R25 +1a constant R26 +1b constant R27 +1c constant R28 +1d constant R29 +1e constant R30 +1f constant R31 +1a constant XL +1b constant XH +1c constant YL +1d constant YH +1e constant ZL +1f constant ZH +01 constant XH:XL \ XH:XL 3F adiw, sbiw, +02 constant YH:YL +03 constant ZH:ZL diff --git a/forth/forth/avr/asm2.fs b/forth/forth/avr/asm2.fs new file mode 100644 index 0000000..0f90355 --- /dev/null +++ b/forth/forth/avr/asm2.fs @@ -0,0 +1,192 @@ +\ ********************************************************************* +\ Filename: asm2.txt * +\ Date: 16.10.2017 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Table driven assembler for Atmega chips +-as +marker -as +hex +: ar: ( n "name" -- ) create does> swap 2* 2* + ; +: ri! ( index n -- ) here swap - dup c@ rot 4 lshift or swap c! ; + +flash ar: rules +\ d mask.shift, r mask.shift +[ 000.0 , 000.0 , ] \ 00 xxxx.xxxx.xxxx.xxxx ret sleep wdr +[ 1f0.4 , 00f.0 , ] \ 01 xxxx.xxxd.dddd.rrrr ld x+ -x y+ -y z+ -z +[ 1f0.4 , 00f.0 , ] \ 02 xxxx.xxxd.dddd.rrrr st x+ -x y+ -y z+ -z +[ 030.4 , 0cf.2 , ] \ 03 xxxx.xxxx.kkpp.kkkk adiw sbiw +[ 0f8.3 , 007.0 , ] \ 04 xxxx.xxxx.aaaa.abbb cbi sbi sbic sbis +[ 1f0.4 , 60f.5 , ] \ 05 xxxx.xaad.dddd.aaaa in +[ 1f0.4 , 60f.5 , ] \ 06 xxxx.xaad.dddd.aaaa out +[ 1f0.4 , 000.0 , ] \ 07 xxxx.xxxd.dddd.xxxx lds +[ 1f0.4 , 000.0 , ] \ 08 xxxx.xxxd.dddd.xxxx sts +[ 1f0.4 , 000.0 , ] \ 09 xxxx.xxxd.dddd.xxxx pop push com neg + \ swap inc asr lsr ror dec +[ 0f0.4 , f0f.4 , ] \ 0a xxxx.kkkk.dddd.kkkk cpi sbci subi ori andi ldi +[ 0f0.4 , 00f.0 , ] \ 0b xxxx.xxxx.dddd.rrrr movw +[ 1f0.4 , 20f.5 , ] \ 0c xxxx.xxrd.dddd.rrrr cpc cp sbc sub add adc cpse + \ and eor or mov mul + \ ( rol lsl tst clr ser ) +[ 1f0.4 , 007.0 , \ 0d xxxx.xxxd.dddd.0rrr bld bst sbrc sbrs +\ 000.0 , 000.0 , \ 0f if then begin until again + +\ 126 opcodes opcode name ruleindex namelen +flash create opcodes +[ 9508 , ," ret" 0 4 ri! ] +[ 9588 , ," sleep" 0 6 ri! ] +[ 0000 , ," nop" 0 4 ri! ] +[ 9000 , ," ld" 1 4 ri! ] +[ 9200 , ," st" 2 4 ri! ] +[ 9600 , ," adiw" 3 6 ri! ] +[ 9700 , ," sbiw" 3 6 ri! ] +[ 9800 , ," cbi" 4 4 ri! ] +[ 9900 , ," sbic" 4 6 ri! ] +[ 9a00 , ," sbi" 4 4 ri! ] +[ 9b00 , ," sbis" 4 6 ri! ] +[ b000 , ," in" 5 4 ri! ] +[ b800 , ," out" 6 4 ri! ] +[ 9000 , ," lds" 7 4 ri! ] +[ 9200 , ," sts" 8 4 ri! ] +[ 900f , ," pop" 9 4 ri! ] +[ 920f , ," push" 9 6 ri! ] +[ 9400 , ," com" 9 4 ri! ] +[ 9401 , ," neq" 9 4 ri! ] +[ 9402 , ," swap" 9 6 ri! ] +[ 9403 , ," inc" 9 4 ri! ] +[ 9405 , ," asr" 9 4 ri! ] +[ 9406 , ," lsr" 9 4 ri! ] +[ 9407 , ," ror" 9 4 ri! ] +[ 940a , ," dec" 9 4 ri! ] +[ 3000 , ," cpi" a 4 ri! ] +[ 4000 , ," sbci" a 6 ri! ] +[ 5000 , ," subi" a 6 ri! ] +[ 6000 , ," ori" a 4 ri! ] +[ 7000 , ," andi" a 6 ri! ] +[ e000 , ," ldi" a 4 ri! ] +[ 0100 , ," movw" b 6 ri! ] +[ 9c00 , ," mul" c 4 ri! ] +[ 0400 , ," cpc" c 4 ri! ] +[ 0800 , ," sbc" c 4 ri! ] +[ 0c00 , ," add" c 4 ri! ] +[ 1000 , ," cpse" c 6 ri! ] +[ 1400 , ," cp" c 4 ri! ] +[ 1800 , ," sub" c 4 ri! ] +[ 1c00 , ," adc" c 4 ri! ] +[ 2000 , ," and" c 4 ri! ] +[ 2400 , ," eor" c 4 ri! ] +[ 2800 , ," or" c 4 ri! ] +[ 2c00 , ," mov" c 4 ri! ] +[ f800 , ," bld" d 4 ri! ] +[ fa00 , ," bst" d 4 ri! ] +[ fc00 , ," sbrc" d 6 ri! ] +[ fe00 , ," sbrs" d 6 ri! ] +[ 0000 , ," if" f 4 ri! ] +[ 0002 , ," then" f 6 ri! ] +[ 0004 , ," begin" f 6 ri! ] +[ 0006 , ," until" f 6 ri! ] +[ 0008 , ," again" f 6 ri! ] +[ ffff , +ram + +flash create sy1 +hex +[ 1 , ," z+" 2 , ," -z" ] +[ 9 , ," y+" a , ," -y" ] +[ d , ," x+" e , ," -x" ] +[ $ffff , +ram + +flash create sy2 +[ f400 , ," cs" ] +[ f400 , ," lo" ] +[ f401 , ," eq" ] +[ f402 , ," mi" ] +[ f403 , ," vs" ] +[ f404 , ," lt" ] +[ f405 , ," hs" ] +[ f406 , ," ts" ] +[ f407 , ," ie" ] +[ f000 , ," cc" ] +[ f000 , ," sh" ] +[ f001 , ," ne" ] +[ f002 , ," pl" ] +[ f003 , ," vc" ] +[ f004 , ," ge" ] +[ f005 , ," hc" ] +[ f006 , ," tc" ] +[ f007 , ," id" ] +[ ffff , +ram +hex +\ +: dsm ( index -- shift mask ) @ dup f and swap 4 rshift ; +: msi ( code index -- code) rules dsm >r lshift r> and ; +: split ( code index -- code ) + rules 2+ dsm >r over swap lshift fff0 and or r> and ; + +: asm ( opc index d/b r/k/a/b -- asm ) + rot >r swap + r@ msi \ dest shifted and masked + swap r> split \ resource splitted and masked + or or ; \ opc n2 n1 combined + +: sy? ( word table -- address ) + begin + @+ 1+ + while + 2dup n= + if c@+ 7 and + aligned + else nip 2- exit + then + repeat + drop c@+ type ." ?" abort ; + +: op? ( word table -- opc index ) sy? dup @ swap 2+ c@ 4 rshift ; + +: bw bl word ; +: N# number? 1- 0= abort" ?" ; +: n# bw N# ; +: d# bw sy1 sy? @ ; +: r# bw dup 1+ dup c@ 4f - swap c! N# 1f and ; +: c# bw sy2 sy? @ ; + +: as1 2+ - 2/ 3 lshift 3f8 and ; +:noname ; \ again +:noname c# >r ihere as1 r> or i, ; \ until +:noname ihere ; \ begin +:noname ihere over as1 over @ or swap ! ; \ then +:noname c# i, ihere 2- ; \ if +flash create ask , , , , , ram + +:noname r# 2/ r# 2/ asm ; \ movw +:noname r# n# asm ; +:noname r# false asm ; \ one param +:noname n# >r r# false asm i, r> ; \ sts +:noname r# n# >r false asm i, r> ; \ lds +:noname n# r# swap asm ; \ out +:noname r# n# asm ; \ in +:noname n# n# asm ; \ sbic 0-31, 0-7 +:noname r# 2/ n# asm ; \ adiw sbiw r24 r26 r28 r30 +:noname d# r# swap asm ; \ st +:noname r# d# asm ; \ ld +:noname drop ; \ no params +flash create ass , , , , , , , , , , , , ram + +: as: ( -- ) + bw opcodes op? + dup f - 0= + if drop ask + @ex \ handle flow control + else + dup $c < + if dup 2* ass + @ex + else r# r# asm \ two params + then i, + then +; immediate + diff --git a/forth/forth/avr/asm2test.fs b/forth/forth/avr/asm2test.fs new file mode 100644 index 0000000..976420b --- /dev/null +++ b/forth/forth/avr/asm2test.fs @@ -0,0 +1,32 @@ + +-asmtest +marker -asmtest + +: qq + as: if eq + as: nop + as: then +; + +: ww + as: begin + as: nop + as: until eq +; +\ square root of unsigned cell. +: sqrt ( u --- u ) + as: adiw r24 1 + as: ldi r16 $00 + as: ldi r17 $80 + as: begin + as: eor r16 r17 + as: mul r16 r16 + as: cp r0 r24 + as: cpc r1 r25 + as: if sh + as: eor r16 r17 + as: then + as: lsr r17 + as: until eq + as: movw r24 r16 +; \ No newline at end of file diff --git a/forth/forth/avr/asmtest.fs b/forth/forth/avr/asmtest.fs new file mode 100644 index 0000000..7ec44ef --- /dev/null +++ b/forth/forth/avr/asmtest.fs @@ -0,0 +1,59 @@ +\ Some tests for the Atmega assembler +\ needs the assembler and see +-asmtest +marker -asmtest +: asmtest ( n1 n2 -- ) + = if ." OK" else ." ERROR" then cr ; + +#30 #28 mov, +flash here ram 2- @ $2fec asmtest \ Rd,Rr: + +#17 #15 ldi, +flash here ram 2- @ $e01f asmtest \ Rd,k: + +#17 $1234 lds, +flash here ram 4 - @+ swap @ u. u. \ Rd: 9110 1234 + +$09 constant Y+ +9 Y+ $31 ldd, + flash here ram 2 - @ $a899 asmtest + +$01 constant Z+ +9 Z+ $31 ldd, + flash here ram 2 - @ $a891 asmtest + +\ Leave true flag if zero flag is true +: testif0 + [ sez, ] \ Set zero flag + [ eq, if, ] \ if zero + true + [ else, ] \ else not zero + false + [ then, ] +; +testif0 . + +\ Leave true flag if zero flag is false +: testif1 + [ clz, ] \ Clear zero flag + [ eq, not, if, ] \ if not zero + true + [ else, ] \ else zero + false + [ then, ] +; +testif1 . + +\ Increment 24 bit value until result is zero +: testuntil + [ #16 #0 ldi, ] + [ #17 #0 ldi, ] + [ #18 #1 ldi, ] + [ begin, ] + [ #16 #6 add, ] \ R6 contains 1 + [ #17 #5 adc, ] \ R5 contains 0 + [ #18 #5 adc, ] + [ eq, until, ] \ until R18 is zero +; +testuntil + diff --git a/forth/forth/avr/bit-test.fs b/forth/forth/avr/bit-test.fs new file mode 100644 index 0000000..cdfdcea --- /dev/null +++ b/forth/forth/avr/bit-test.fs @@ -0,0 +1,58 @@ +\ ********************************************************************* +\ * +\ Filename: bit-test.txt * +\ Date: 06.01.2015 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Test words for manipulating bits in ram and in IO registers +\ Needs bit.txt +-bittest +marker -bittest + +\ BIT addressable IO register +\ $20 - $3f +$22 constant porta + +\ IN OUT addressable IO register +$4a constant gpior1 + +\ LDS STS addressable IO register +$124 constant tcnt5l + +porta 2 bit0: porta2off +porta 2 bit1: porta2on +porta 2 bit?: porta2? + +gpior1 0 bit0: gpio0off +gpior1 0 bit1: gpio0on +gpior1 0 bit?: gpio0? + +tcnt5l 7 bit0: tcnt5l7off +tcnt5l 7 bit1: tcnt5l7on +tcnt5l 7 bit?: tcnt5l7? + +-1 porta c! +porta2off porta c@ . porta2? . +porta2on porta c@ . porta2? . +0 porta c! +porta2on porta c@ . porta2? . +porta2off porta c@ . porta2? . + +-1 gpior1 c! +gpio0off gpior1 c@ . gpio0? . +gpio0on gpior1 c@ . gpio0? . +0 gpior1 c! +gpio0off gpior1 c@ . gpio0? . +gpio0on gpior1 c@ . gpio0? . +0 gpior1 c! +-1 tcnt5l c! +tcnt5l7off tcnt5l c@ . tcnt5l7? . +tcnt5l7on tcnt5l c@ . tcnt5l7? . +0 tcnt5l c! +tcnt5l7on tcnt5l c@ . tcnt5l7? . +tcnt5l7off tcnt5l c@ . tcnt5l7? . diff --git a/forth/forth/avr/bit.fs b/forth/forth/avr/bit.fs new file mode 100644 index 0000000..c61e48e --- /dev/null +++ b/forth/forth/avr/bit.fs @@ -0,0 +1,77 @@ +\ ********************************************************************* +\ * +\ Filename: bit.txt * +\ Date: 06.01.2015 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Words for manipulating bits in ram. +\ Memory mapped addresses of I/O ports must be used. +\ CBI SBI SBIS instructions will be generated for adresses $20-$3f +\ IN and OUT instruction will be used for addresses $40 to $5f +\ LDS and STS instructions will be used for addresses over $60 +\ Bit has value 0..7 + +-bit +marker -bit +: (bio) ( c-addr -- in/out-addr ) $20 - dup $5 lshift or $60f and ; +: (bit) ( c-addr bit flag "name" -- ) + : >r + over $40 < if + swap $20 - 3 lshift or + r> + if $9a00 \ sbi io-addr, bit + else $9800 \ cbi io-addr, bit + then or i, + else + over $60 < + if over (bio) $b100 or \ in r16 io-addr + else $9100 i, over \ lds r16 c-addr + then i, + 1 swap lshift + r> + if $6000 >r + else $7000 >r invert $ff and + then dup 4 lshift or $f0f and r> or i, \ andi/ori r16, mask + dup $60 < + if (bio) $b900 or \ out io-addr r16 + else $9300 i, \ sts c-addr r16 + then i, + then + $9508 i, \ return + postpone [ +; + +\ Define a word that clears a bit in ram +\ The defined word can be inlined +( c-addr bit "name" -- ) +: bit0: false (bit) ; + +\ Define a word that sets a bit in ram +\ The defined word can be inlined +( c-addr bit "name" -- ) +: bit1: true (bit) ; + +\ Define a word that leaves a true flag if a bit in ram is one +\ and a false flag if a bit is zero. +\ The defined word can be inlined +( c-addr bit "name" -- ) +: bit?: + : + $939a i, $938a i, $ef8f i, $ef9f i, \ true + over $40 < if + swap $20 - 3 lshift or $9b00 or i, \ sbis io-addr, bit + else + over $60 < + if swap (bio) $b100 or \ in r16 io-addr + else $9100 i, swap \ lds r16 c-addr + then i, $ff00 or i, \ sbrs r16, bit + then + $9601 i, \ 1+ + $9508 i, \ return + postpone [ +; diff --git a/forth/forth/avr/doloop.fs b/forth/forth/avr/doloop.fs new file mode 100644 index 0000000..7b7eab2 --- /dev/null +++ b/forth/forth/avr/doloop.fs @@ -0,0 +1,92 @@ +\ ********************************************************************* +\ * +\ Filename: doloop.txt * +\ Date: 11.04.2017 * +\ File Version: 5.0 * +\ MCU: Atmega (not 256) * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ do loop for Atmega32,64,128 (not 256) +-doloop +marker -doloop + +: compileonly $10 shb ; + +#20 constant ind inlined \ R18:R19 are unused by the kernel + +: (do) ( limit index -- R: leave oldindex xfaxtor ) + r> + dup >a xa> @ >r \ R: leave + ind @ >r \ R: leave oldindex + swap $8000 swap - dup >r \ R: leave oldindex xfactor + + ind ! + a> 1+ >r +; compileonly + +: (?do) ( limit index -- R: leave oldindex xfactor ) + 2dup xor + if + [ ' (do) ] again \ branch to (do) + then + r> xa> @ >r 2drop +; compileonly + +: (+loop) ( n -- ) + [ $0f48 i, ] \ add r20, tosl + [ $1f59 i, ] \ add r21, tosh + inline drop +; compileonly + +: unloop + r> + rdrop r> ind ! rdrop + >r +; compileonly + +: do + postpone (do) + postpone begin + flash 2 allot ram \ leave address + postpone begin +; immediate compileonly + +: ?do + postpone (?do) + postpone begin + flash 2 allot ram \ leave address + postpone begin +; immediate compileonly + +: leave + rdrop rdrop r> ind ! +; compileonly + +: i + ind @ rp@ 3 + @ >< - +; compileonly + +: j + rp@ 5 + @ >< rp@ 9 + @ >< - +; compileonly + + +: loop + $0d46 i, $1d55 i, \ add 1 to r20:r21 +\ postpone (loop) + $f00b i, \ bra +2 if overflow + postpone again + postpone unloop + flash here >xa swap ! ram +; immediate compileonly + +: +loop + postpone (+loop) + $f00b i, \ bra +2 if overflow + postpone again + postpone unloop + flash here >xa swap ! ram +; immediate compileonly + diff --git a/forth/forth/avr/i2c-base-avr.fs b/forth/forth/avr/i2c-base-avr.fs new file mode 100644 index 0000000..50f9abc --- /dev/null +++ b/forth/forth/avr/i2c-base-avr.fs @@ -0,0 +1,99 @@ +\ i2c-base-avr.txt +\ Low-level words for TWI/I2C on Atmega328P. +\ +\ Modelled on i2c-twi.frt from amforth, +\ i2c_base.txt for FlashForth on PIC18 +\ and the Atmel datasheet, of course. +\ Peter J. 2014-10-27 +\ Watchdog added Mikael Nordman @ 12.5.2017 + +-i2c-base +marker -i2c-base +hex ram + +\ Two-Wire-Interface Registers +$b8 constant TWBR +$b9 constant TWSR +$bb constant TWDR +$bc constant TWCR + +\ Bits in the Control Register +%10000000 constant mTWINT +%01000000 constant mTWEA +%00100000 constant mTWSTA +%00010000 constant mTWSTO +%00001000 constant mTWWC +%00000100 constant mTWEN +%00000001 constant mTWIE + +: i2c.init ( -- ) \ Set clock frequency to 100kHz + %11 TWSR mclr \ prescale value = 1 + [ Fcy #100 / #16 - 2/ ] literal TWBR c! + mTWEN TWCR mset +; + +: i2c.wait ( -- ) \ Wait for operation to complete + \ When TWI operations are done, the hardware sets + \ the TWINT interrupt flag, which we will poll. + \ Watchdog timeout + 7 wd+ begin TWCR c@ mTWINT and until wd- +; + +: i2c.start ( -- ) \ Send start condition + [ mTWINT mTWEN or mTWSTA or ] literal TWCR c! + i2c.wait +; + +: i2c.rsen ( -- ) \ Send repeated start condition + i2c.start \ AVR doesn't distinguish +; + +: i2c.stop ( -- ) \ Send stop condition + [ mTWINT mTWEN or mTWSTO or ] literal TWCR c! +; + +\ Write one byte to bus, returning 0 if ACK was received, -1 otherwise. +: i2c.c! ( c -- f ) + i2c.wait \ Must have TWINT high to write data + TWDR c! + [ mTWINT mTWEN or ] literal TWCR c! + i2c.wait + \ Test for arrival of an ACK depending on what was sent. + TWSR c@ $f8 and $18 = if 0 exit then \ SLA+W + TWSR c@ $f8 and $28 = if 0 exit then \ data byte + TWSR c@ $f8 and $40 = if 0 exit then \ SLA+R + -1 \ Something other than an ACK resulted +; + +\ Read one byte and ack for another. +: i2c.c@.ack ( -- c ) + [ mTWINT mTWEN or mTWEA or ] literal TWCR c! + i2c.wait + TWDR c@ +; + +\ Read one last byte. +: i2c.c@.nack ( -- c ) + [ mTWINT mTWEN or ] literal TWCR c! + i2c.wait + TWDR c@ +; + +\ Address slave for writing, leaving true if slave ready. +: i2c.addr.write ( 7-bit-addr -- ) + 2* \ Build full byte with write-bit as 0 + i2c.start i2c.c! if false else true then +; + +\ Address slave for reading, leaving true if slave ready. +: i2c.addr.read ( 7-bit-addr -- ) + 2* 1+ \ Build full byte with read-bit as 1 + i2c.start i2c.c! if false else true then +; + +\ Detect presence of device, leaving true if slave responded. +\ If the slave ACKs the read request, fetch one byte only. +: i2c.ping? ( 7-bit-addr -- f ) + 2* 1+ \ Build full byte with read-bit as 1 + i2c.start i2c.c! 0= if i2c.c@.nack drop true else false then +; diff --git a/forth/forth/avr/i2c-ds1307.fs b/forth/forth/avr/i2c-ds1307.fs new file mode 100644 index 0000000..20aa069 --- /dev/null +++ b/forth/forth/avr/i2c-ds1307.fs @@ -0,0 +1,72 @@ +\ ********************************************************************* +\ * +\ Filename: i2c-ds1307.txt * +\ Date: 12.05.2016 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* + +\ ******************************** +\ DS1307 RTC i2c words +\ ******************************** +-ds1307 +marker -ds1307 + +\ i2c device address +$68 constant addr-ds1307 + +: i2c! i2c.c! drop ; + +: ds1307.addr! ( c -- ) \ Set ds1307 register address + i2c.init addr-ds1307 i2c.addr.write drop + i2c! i2c.stop ; + +: time! ( c c c c c c c -- ) + i2c.init addr-ds1307 i2c.addr.write drop + 0 i2c! i2c! i2c! i2c! i2c! i2c! i2c! i2c! + i2c.stop +; + +: time@ ( -- c c c c c c c ) + 0 ds1307.addr! + addr-ds1307 i2c.addr.read drop + i2c.c@.ack i2c.c@.ack i2c.c@.ack + i2c.c@.ack i2c.c@.ack i2c.c@.ack i2c.c@.nack + i2c.stop +; + +: bin>bcd ( c -- c ) + #10 u/mod #4 lshift or +; +: set-time ( year month date day hour min sec -- ) + >r >r >r >r >r >r + $00 swap \ 11 = 4.096 KHz output 00 = no output + bin>bcd \ Year 0-99 + r> bin>bcd \ Month + r> bin>bcd \ Date + r> \ Day 1-7 + r> bin>bcd \ Hours + r> bin>bcd \ Minutes + r> bin>bcd \ Seconds + time! +; + +: i2c.ds1307.c@ ( addr -- c ) + ds1307.addr! addr-ds1307 i2c.addr.read drop i2c.c@.nack i2c.stop +; +: i2c.ds1307.c! ( c addr -- ) + i2c.init addr-ds1307 i2c.addr.write drop i2c! i2c! i2c.stop +; + + +: i2c.ds1307.n@ ( n addr -- ) + ds1307.addr! + addr-ds1307 i2c.addr.read drop + for i2c.c@.ack next + i2c.c@.nack i2c.stop +; + diff --git a/forth/forth/avr/irqAtmega128.fs b/forth/forth/avr/irqAtmega128.fs new file mode 100644 index 0000000..43e20f9 --- /dev/null +++ b/forth/forth/avr/irqAtmega128.fs @@ -0,0 +1,45 @@ +\ ********************************************************************* +\ Interrupts example for FlashForth * +\ Filename: irq.txt * +\ Date: 04.10.2013 * +\ FF Version: 5.0 * +\ MCU: Atmega128 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Disable interrupt before removing the interrupt code +irqOvf3Dis +-irqOvf3 +marker -irqOvf3 +\ Timer 3 definitions from m128def.inc +$8a constant tccr3b +$7d constant etimsk +#30 constant ovf3Ivec + +\ Counter for timer overflows +variable counter + +\ The interrupt routine +: t3OverflowIsr + 1 counter +! +;i + +: irqOvf3Init + \ Store the interrupt vector + ['] t3OverflowIsr ovf3Ivec int! + \ Activate counter 3 + 1 tccr3b mset + \ Activate timer3 overflow interrupt + 4 etimsk mset +; +: irqOvf3Dis + 4 etimsk mclr +; + +irqOvf3Init + +counter @ u. +#1000 ms +counter @ u. diff --git a/forth/forth/avr/irqAtmega2560.fs b/forth/forth/avr/irqAtmega2560.fs new file mode 100644 index 0000000..4a75b87 --- /dev/null +++ b/forth/forth/avr/irqAtmega2560.fs @@ -0,0 +1,45 @@ +\ ********************************************************************* +\ Interrupts example for FlashForth * +\ Filename: irqAtmega2560.txt * +\ Date: 04.10.2013 * +\ FF Version: 5.0 * +\ MCU: Atmega2560 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Disable interrupt before removing the interrupt code +irqOvf3Dis +-irqOvf3 +marker -irqOvf3 +\ Timer 3 definitions from m2560def.inc +$91 constant tccr3b +$71 constant timsk3 +#36 constant ovf3Ivec + +\ Counter for timer overflows +variable counter + +\ The interrupt routine +: t3OverflowIsr + 1 counter +! +;i + +: irqOvf3Init + \ Store the interrupt vector + ['] t3OverflowIsr ovf3Ivec int! + \ Activate counter 3 + 1 tccr3b mset + \ Activate timer3 overflow interrupt + 1 timsk3 mset +; +: irqOvf3Dis + 1 timsk3 mclr +; + +irqOvf3Init + +counter @ . +#1000 ms +counter @ . diff --git a/forth/forth/avr/irqAtmega328.fs b/forth/forth/avr/irqAtmega328.fs new file mode 100644 index 0000000..2f6a53f --- /dev/null +++ b/forth/forth/avr/irqAtmega328.fs @@ -0,0 +1,42 @@ +\ ********************************************************************* +\ Interrupts example for FlashForth * +\ Filename: irqAtmega328.txt * +\ Date: 10.11.2014 * +\ FF Version: 5.0 * +\ MCU: Atmega328 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Disable interrupt before removing the interrupt code +irqOvf2Dis +-irqOvf2 +marker -irqOvf2 +\ Timer 2 definitions from m328pdef.inc +$b1 constant tccr2b +$70 constant timsk2 +#10 constant ovf2Ivec + +\ Counter for timer overflows +variable counter + +\ The interrupt routine +: t2OverflowIsr + 1 counter +! +;i + +: irqOvf2Init + \ Store the interrupt vector + ['] t2OverflowIsr ovf2Ivec int! + \ Activate counter 2 + 3 tccr2b c! + \ Activate timer2 overflow interrupt + 1 timsk2 mset +; +: irqOvf2Dis + 1 timsk2 mclr +; + +\ irqOvf2Init + diff --git a/forth/forth/avr/pick.fs b/forth/forth/avr/pick.fs new file mode 100644 index 0000000..b27dfcb --- /dev/null +++ b/forth/forth/avr/pick.fs @@ -0,0 +1,6 @@ +\ PICK for the Atmega by +\ Pablo - EA4FUK + +\ xu ... x0 u -- xu ... x0 xu +: pick 2* sp@ + @ ; + diff --git a/forth/forth/avr/see.fs b/forth/forth/avr/see.fs new file mode 100644 index 0000000..a1c2deb --- /dev/null +++ b/forth/forth/avr/see.fs @@ -0,0 +1,77 @@ +\ ********************************************************************* +\ Filename: see.txt * +\ Date: 20.03.2017 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +-see +marker -see +hex ram +: *@ dup @ ; +: u.4 4 u.r ; +: *@+ dup cell+ @ u.4 ; +: 5sp 5 spaces ; +: @braddr ( addr -- addr xt-addr ) + *@ fff and dup 800 and + if f800 or then 2* over + cell+ ; +: @xtaddr ( addr -- addr xt-addr ) + dup cell+ @ xa> ; +: .rjmp ( addr -- addr+2 ) @braddr u.4 cell+ ; +: .br ( addr -- addr+2 ) + *@ 3 rshift 7f and dup 40 and + if ff80 or then 2* over + cell+ u.4 cell+ ; +: .reg ( addr -- addr ) + dup @ 4 rshift 1f and ." r" decimal 2 u.r hex cell+ ; +: .ldi ( addr -- addr ) + *@ dup 4 rshift dup 000f and 0010 + + ." r" decimal 2 u.r hex + 00f0 and swap 000f and + 2 u.r cell+ ; +: ?call ( addr -- addr f ) *@ fe0e and 940e - ; +: ?ret ( addr -- addr f ) *@ 9508 - ; +: ?rcall ( addr -- addr f ) *@ f000 and d000 - ; +: ?jmp ( addr -- addr f ) *@ fe0e and 940c - ; +: ?rjmp ( addr -- addr f ) *@ f000 and c000 - ; +: ?breq ( addr -- addr f ) *@ fc07 and f001 - ; +: ?brne ( addr -- addr f ) *@ fc07 and f401 - ; +: ?brcc ( addr -- addr f ) *@ fc07 and f400 - ; +: ?pop ( addr -- addr f ) *@ fe0f and 900f - ; +: ?push ( addr -- addr f ) *@ fe0f and 920f - ; +: ?st-y ( addr -- addr f ) *@ fe0f and 920a - ; +: ?ldy+ ( addr -- addr f ) *@ fe0f and 9009 - ; +: ?ijmp ( addr -- addr f ) *@ 9409 - ; +: ?ldi ( addr -- addr f ) *@ f000 and e000 - ; +: (see) ( addr -- addr' | false ) + dup u.4 + *@ u.4 + ?call 0= if *@+ ." call " @xtaddr c>n .id cell+ cell+ else + ?rcall 0= if 5sp ." rcall " @braddr c>n .id cell+ else + ?breq 0= if 5sp ." breq " .br else + ?brne 0= if 5sp ." brne " .br else + ?brcc 0= if 5sp ." brcc " .br else + ?rjmp 0= if 5sp ." rjmp " .rjmp else + ?ijmp 0= if 5sp ." ijmp" drop false else + ?ret 0= if 5sp ." ret" drop false else + ?jmp 0= if *@+ ." jmp " @xtaddr c>n .id drop false else + ?pop 0= if 5sp ." pop " .reg else + ?push 0= if 5sp ." push " .reg else + ?ldy+ 0= if 5sp ." ld " .reg ." y+" else + ?st-y 0= if 5sp ." st -y " .reg else + ?ldi 0= if 5sp ." ldi " .ldi else + cell+ + then then then then then + then then then then then + then then then then + cr ; + +: dis ( addr -- ) + hex cr + begin (see) dup 0= + until drop ; + +: see ( "word" -- ) ' dis ; +hex ram + diff --git a/forth/forth/avr/task-test-arduino-mega2560.fs b/forth/forth/avr/task-test-arduino-mega2560.fs new file mode 100644 index 0000000..2f47a29 --- /dev/null +++ b/forth/forth/avr/task-test-arduino-mega2560.fs @@ -0,0 +1,48 @@ +\ ******************************************************************* +\ * +\ Filename: task-test-arduino-uno.txt * +\ Date: 02.10.2013 * +\ FF Version: 5.0 * +\ MCU: ArduinoMega2560R3 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ Demo for the ArduinoMega2560R3. Blinks red led in background task. +single +-task1 +marker -task1 +ram hex +\ Registers for Atmega 2560. +$0025 constant portb +$0024 constant ddrb +$0023 constant pinb +$80 constant pin7 +ram variable delay +: ledoff pin7 portb mclr ; +: ledon pin7 portb mset ; + +0 18 20 0 task: task1 +: taskloop + $100 delay ! + pin7 ddrb mset \ Output + begin + delay @ ms + pin7 portb mtst + if + ledoff + else + ledon + then + again +; + +: t1go + ['] taskloop task1 tinit + task1 run +; + +' t1go is turnkey +warm + diff --git a/forth/forth/avr/task-test-arduino-uno.fs b/forth/forth/avr/task-test-arduino-uno.fs new file mode 100644 index 0000000..a119ae5 --- /dev/null +++ b/forth/forth/avr/task-test-arduino-uno.fs @@ -0,0 +1,45 @@ +\ ******************************************************************* +\ * +\ Filename: task-test-arduino-uno.txt * +\ Date: 01.10.2013 * +\ FF Version: 5.0 * +\ MCU: ArduinoUnoR3 ATmega328P * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ Demo for the ArduinoUnoR3. Blinks yellow led in background task. +single +-task1 +marker -task1 +ram hex +\ Registers for Atmega 328p. +$0025 constant portb +$0024 constant ddrb +$0023 constant pinb +$20 constant pin5 +ram variable delay +: ledoff pin5 portb mclr ; +: ledon pin5 portb mset ; + +0 18 20 0 task: task1 +: taskloop + $100 delay ! + pin5 ddrb mset \ Output + begin + delay @ ms + pin5 portb mtst + if + ledoff + else + ledon + then + again +; + +: t1go ['] taskloop task1 tinit task1 run ; + +' t1go is turnkey +warm + diff --git a/forth/forth/avr/task-test.fs b/forth/forth/avr/task-test.fs new file mode 100644 index 0000000..815aaf4 --- /dev/null +++ b/forth/forth/avr/task-test.fs @@ -0,0 +1,45 @@ +\ ******************************************************************* +\ * +\ Filename: task-test.txt * +\ Date: 06.01.2014 * +\ FF Version: 5.0 * +\ MCU: Atmega 128(Olimex AVR-MT-128) * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ Demo for the Olimex AVR-MT-128. Switches relay and blinks led in +\ background task. +single +-task1 +marker -task1 +ram hex +\ Registers for Atmega 128. Change if needed +$003b constant porta +$003a constant ddra +$0039 constant pina +$40 constant pin6 +ram variable delay +: ledoff pin6 porta mclr ; +: ledon pin6 porta mset ; + +0 18 20 0 task: task1 +: taskloop + 400 delay ! + $40 ddra mset \ Output + begin + delay @ ms + pin6 porta mtst + if + ledoff + else + ledon + then + again +; + +: t1go ['] taskloop task1 tinit task1 run ; + +\ ' t1go is turnkey +\ warm diff --git a/forth/forth/avr/task.fs b/forth/forth/avr/task.fs new file mode 100644 index 0000000..1a96928 --- /dev/null +++ b/forth/forth/avr/task.fs @@ -0,0 +1,160 @@ +\ ******************************************************************* +\ * +\ Filename: task.txt * +\ Date: 07.06.2015 * +\ FF Version: 5.0 * +\ MCU: Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ TASK leaves the userarea address on the stack. +\ The basic size of a task is decimal 32 bytes. +\ The return stack, the parameter stack and the tib buffer areas +\ are in addition to that. +\ These are allocated at the end (high address) of the user area. +\ Own user varibles can be allocated from offset 2 upwards, +\ below the return stack. Addsize must reflect any additonal +\ user variables that are used. +\ uareasize = 32 + rsize + tibsize + ssize + addsize +\ +\ The operator task is predefined. +\ flash decimal 72 72 72 0 task: operator +\ +\ A background task with a 12 cell return stack and a +\ 12 cell parameter stack and no tib. +\ flash decimal 0 24 24 0 task: bg1 +\ +\ A background task with also one extra user variable. +\ flash decimal 0 24 24 2 task: bg2 +\ ram decimal 2 user bg2_cnt + +\ Do not use user variables as task specific variables +\ User variables are needed by _words_common_to_several_tasks_ +\ which need some task specific data storage. + +-task +marker -task +hex ram + +\ Near definition saves memory ! +: up! up ! ; +: up@ up @ ; +: op@ operator @ ; +: ul@ ulink @ ; +: ul! ulink ! ; +: op! op@ up! ; +\ access user variables of other task +: his ( task-addr var-addr -- addr ) + up@ - swap @ + +; + +\ Define a new task +\ A new task must be defined in the flash memory space +: task: ( tibsize stacksize rsize addsize -- ) + flash create + up@ s0 - dup \ Basic size ts ss rs as bs bs + ram here + flash , \ User pointer ts ss rs as bs + 4 for + over , + + next + cell+ \ Task size + ram allot +; + +\ Initialise a user area and link it to the task loop +\ May only be executed from the operator task +: tinit ( taskloop-addr task-addr -- ) + \ use task user area + @+ up! \ a addsize-addr + ul@ if \ ? Already running + 2drop + else + \ Pointer to task area + dup 2- task ! + \ r0 = uarea+addsize+rsize + @+ swap @+ rot + up@ + \ a ssize-addr r0 + \ Save r0 + r0 ! \ a ssize-addr + \ s0 = r0 + ssize + @ r0 @ + s0 ! \ a + \ Store task-loop address to the return stack + r0 @ x>r \ rsp + \ Store SP to return stack + 1- dup s0 @ swap ! \ rsp + \ Store current rsp and space for saving TOS and P PAUSE + 5 - rsave ! \ + \ tiu = s0 + 2 + s0 @ 2+ tiu ! + 0 ul! + 0 task 2+ ! \ clear status and cr flag + decimal \ Set the base to decimal + then + op! \ run the operator task again +; + +\ Insert a new task after operator in the linked list. +\ May only be executed from the operator task +: run ( task-addr -- ) + @ up! ul@ 0= if \ ? Already running + up@ \ task-uarea + op! ul@ \ task-uarea operator-ulink + over ul! + swap up! ul! + then + op! \ run operator task +; + +\ End a task by linking it out from the linked list +\ May only be executed from the operator task +: end ( task-addr -- ) + @ up! ul@ if + up@ + op! + begin \ find the uarea in the linked list + dup ul@ <> \ uarea flag + while + ul@ up! \ uarea + repeat + up@ \ uarea prev-uarea + swap up! \ prev-uarea + ul@ \ prev-uarea next-uarea + 0 ul! \ ulink of a ended task is zero + swap up! \ next-uarea + ul! \ + then + op! +; + +\ End all tasks except the operator task +\ May only be executed from the operator task +: single ( -- ) + ul@ op@ <> if \ Are there any running tasks + ul@ op@ ul! \ link operator to himself + up! \ move to next user area + begin + ul@ op@ <> \ is this the last linked user area + while + ul@ 0 ul! \ write zero to ulink + up! \ and move to next user area + repeat + 0 ul! + op! + then +; + +\ List all running tasks +: tasks ( -- ) + up@ op! + begin + up@ + task @ 6 - op! c>n .id space + up! + ul@ op@ - + while + ul@ up! + repeat + up! +; + diff --git a/forth/forth/avr/task2-test.fs b/forth/forth/avr/task2-test.fs new file mode 100644 index 0000000..2897fe1 --- /dev/null +++ b/forth/forth/avr/task2-test.fs @@ -0,0 +1,47 @@ +\ ******************************************************************* +\ * +\ Filename: task2-test.txt * +\ Date: 01.03.2014 * +\ FF Version: 5.0 * +\ MCU: Atmega 328(Olimex AVR-P28) * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ Demo for the Olimex AVR-P28 with Atmega328P. Blinks led in +\ background task. +single +-task2 +marker -task2 +ram hex +\ Registers for Atmega 328P. Change if needed +$0028 constant portc +$0027 constant ddrc +$20 constant pin5 + +ram variable delay + +: ledoff pin5 portc mset ; +: ledon pin5 portc mclr ; + +0 18 20 0 task: task2 +: task2loop + 100 delay ! + pin5 ddrc mset \ Output + begin + delay @ ms + pin5 portc mtst + if + ledon + else + ledoff + then + again +; + +: t2go ['] task2loop task2 tinit task2 run ; + +' t2go is turnkey +warm + diff --git a/forth/forth/avr/us.fs b/forth/forth/avr/us.fs new file mode 100644 index 0000000..2cd0eda --- /dev/null +++ b/forth/forth/avr/us.fs @@ -0,0 +1,37 @@ +\ microseconds delay for Atmega +-us +marker -us + +\ Opcode only to flash +: op: ( opcode -- ) flash create , ram does> @ i, ; + +\ Atmega wdr instruction +$95a8 op: wdr, + +\ clear watchdog +: cwd [ wdr, ] ; inlined + +\ Clear watchdog (wdr instruction) takes one clock cycle +\ Adjust the number of CWD to achieve a one us delay +\ 9 CWD is needed @ 16MHz for ATmega 328 and 2560. +: us ( u -- ) \ busy wait for u microseconds + begin + cwd cwd cwd cwd cwd cwd cwd cwd cwd + 1- dup + 0= until + drop +; + +\ Helper word for calibrating the us loop +-us-cal +marker -us-cal +: us-cal ( u -- ) \ give target delay in ms + ticks >r + for #1000 us next + ticks r> - #1000 um* + cr d. ." microseconds" +; + +decimal +1000 us-cal + diff --git a/forth/forth/avr/xdump.fs b/forth/forth/avr/xdump.fs new file mode 100644 index 0000000..e8a4d93 --- /dev/null +++ b/forth/forth/avr/xdump.fs @@ -0,0 +1,45 @@ +\ ********************************************************************* +\ * +\ Filename: xdump.txt * +\ FlashForth: 5.0 * +\ MCU ATmega * +\ Application: * +\ * +\ Author: Mikael Nordman * +\ * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* + +-xdump +marker -xdump + +\ Display the contents of raw FLASH memory, +\ given the starting address and length. +\ The address is a raw address without mapping +\ Displays in hex notation and printable ASCII. +\ xdump expects base to be hex. +\ + +: ud.r <# 1- for # next #s #> type ; +: u.2 $ff and 0 2 ud.r space ; +: xx@ 2dup x@ dup ; + +\ Extended Memory Dump. +\ +: xdump ( d.addr +n -- ) + rot $fffe and \ start on even address + rot rot $10 u/ \ number of rows to print + for + cr 2dup 6 ud.r + [char] : emit space \ display row addr + $8 for + xx@ u.2 #8 rshift u.2 2 m+ + next + -$10 m+ \ wind back the addr + $8 for \ print ASCII + xx@ >pr emit >< >pr emit 2 m+ + next + next + 2drop cr ; + diff --git a/forth/forth/case-test.fs b/forth/forth/case-test.fs new file mode 100644 index 0000000..40aaf03 --- /dev/null +++ b/forth/forth/case-test.fs @@ -0,0 +1,23 @@ +-case-test +marker -case-test +ram hex + +: case-test + case + 2 of ." two " 2222 endof + 3 of ." three " 3333 endof + default ." default " 9999 endof + endcase + u. +; + +2 case-test +3 case-test +8 case-test + +: case-test2 + case + 11 of endof + default endof + endcase +; diff --git a/forth/forth/case.fs b/forth/forth/case.fs new file mode 100644 index 0000000..b50070f --- /dev/null +++ b/forth/forth/case.fs @@ -0,0 +1,52 @@ +\ ********************************************************************* +\ Case for FlashForth * +\ Filename: case.txt * +\ Date: 26.01.2014 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ A case implementation posted by Jenny Brien on c.l.f. +\ Modified to use for..next instead of do..loop + +-case +marker -case +hex ram + +\ of compare +: (of) ( n1 n2 -- n1 flag ) + inline over + inline - + 0= +; + +: case ( -- #of ) + 0 +; immediate + +: of ( #of -- #of orig ) + postpone (of) ( copy and test case value) + postpone if ( add orig to control flow stack ) + postpone drop ( discard case value if case is matching ) +; immediate + +: default ( #of -- #of orig ) + postpone true ( Force to take the default branch ) + postpone if ( add orig to control flow stack ) + postpone drop ( discard case value ) +; immediate + +: endof ( orig1 -- orig2 #of ) + postpone else + swap 1+ +; immediate + +: endcase ( orig1..orign #of -- ) + postpone drop ( discard case value ) + for + postpone then ( resolve of branches ) + next +; immediate + diff --git a/forth/forth/core.fs b/forth/forth/core.fs new file mode 100644 index 0000000..feaea2a --- /dev/null +++ b/forth/forth/core.fs @@ -0,0 +1,49 @@ +\ ********************************************************************* +\ * +\ Filename: core.txt * +\ Date: 31.12.2013 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Some extra core words + +-core +marker -core +hex ram + +\ Interpret a string. The string must be in ram +: evaluate ( caddr n -- ) + 'source 2@ >r >r >in @ >r + interpret + r> >in ! r> r> 'source 2! +; + +: forget ( --- name ) + bl word latest @ (f) ?abort? + c>n 2- dup @ ?abort? + dup flash dp ! @ latest ! ram +; + + ( addr n c -- ) \ fill addr to addr+n with c +: fill rot !p>r swap for dup pc! p+ next r>p drop ; + +\ addr n -- +: erase 0 fill ; + +\ addr n -- +: blanks bl fill ; + +\ x -- 0 | x x +: ?dup dup if inline dup then ; + +\ nfa -- flag +: in? c@ $40 and ; + +\ addr -- addr+1 n +: count c@+ ; + +hex ram + diff --git a/forth/forth/ct-test.fs b/forth/forth/ct-test.fs new file mode 100644 index 0000000..6837d87 --- /dev/null +++ b/forth/forth/ct-test.fs @@ -0,0 +1,22 @@ +\ USAGE EXAMPLE +: ?9 dup 9 = ; +: ?6 dup 6 = ; +: .9 ." nine" cr ; +: .6 ." six" cr ; +' .6 ' ?6 ' .9 ' ?9 +2 flash ct test ram + +\ WITH noname: + +:noname ." default" cr ; +' true +:noname ." six" cr ; +:noname dup 6 = ; +:noname ." nine" cr ; +:noname dup 9 = ; +3 flash ct testnoname + +6 test +6 testnoname +. +. diff --git a/forth/forth/ct.fs b/forth/forth/ct.fs new file mode 100644 index 0000000..1e3ef04 --- /dev/null +++ b/forth/forth/ct.fs @@ -0,0 +1,40 @@ +\ ********************************************************************* +\ * +\ Filename: ct.txt * +\ Date: 06.01.2014 * +\ File Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ create an condition table with n entries +\ each entry consists of a comparison word +\ and an execution word, which is executed if +\ the comparison word leaves a true value on the stack. +-ct +marker -ct +hex ram +: ct ( ew cw n -- ) \ compile a condition table + ( m -- m ) \ execute aword corresponding to m. + \ m may consist of several stack cells + \ it is upto the condition word to + \ preserve m on the stack + create + dup , \ store the condition table size + for + , , \ store an entry + next + does> \ m addr + dup @ \ m addr n + for + cell+ dup \ m addr addr + cell+ >r \ m addr + @ex \ m flag + if \ m + r> @ex rdrop exit \ m a match was found + then + r> + next + drop +; diff --git a/forth/forth/doloop-test.fs b/forth/forth/doloop-test.fs new file mode 100644 index 0000000..c526a8a --- /dev/null +++ b/forth/forth/doloop-test.fs @@ -0,0 +1,32 @@ +\ test some do loop words +-test +marker -test +decimal + +: tdo0 3 0 do cr i . loop ; +: tdo1 do i . i 5 = if leave then loop cr ." leaving" ; +: tdo2 do 10 0 do j . i . loop loop ; +: tdo3 ?do i . 1 +loop cr ." leaving" ; +: tdo4 do i . 10 +loop ; +: tdo5 do i . -10 +loop ; +: tdo ticks #30000 0 do loop ticks swap - u. ; +: tfor ticks #30000 for next ticks swap - u. ; +\ +cr +tdo0 +cr +10 0 tdo1 +cr +3 0 tdo2 +cr +0 0 tdo3 +cr +10 0 tdo3 +cr +100 0 tdo4 +cr +0 100 tdo5 +cr +tdo +cr +tfor diff --git a/forth/forth/dump.fs b/forth/forth/dump.fs new file mode 100644 index 0000000..7a6908f --- /dev/null +++ b/forth/forth/dump.fs @@ -0,0 +1,26 @@ +\ ******************************************************************* +\ * +\ Filename: dump.txt * +\ Date: 14.11.2010 * +\ FF Version: 3.6 4.7 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +: dump ( addr +n -- ) + $10 u/ + for + cr dup 4 u.r [char] : emit \ display row addr + $10 + for \ display bytes + c@+ 2 u.r + next + $10 - + $10 + for \ display ASCII + c@+ >pr emit + next + next + drop cr +; diff --git a/forth/forth/forget.fs b/forth/forth/forget.fs new file mode 100644 index 0000000..8e226fd --- /dev/null +++ b/forth/forth/forget.fs @@ -0,0 +1,18 @@ +\ ********************************************************************* +\ * +\ Filename: core.txt * +\ Date: 31.12.2013 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Some extra core words + +: forget ( --- name ) + bl word latest @ (f) ?abort? + c>n 2- dup @ ?abort? + dup flash dp ! @ latest ! ram +; + diff --git a/forth/forth/free.fs b/forth/forth/free.fs new file mode 100644 index 0000000..e4974a6 --- /dev/null +++ b/forth/forth/free.fs @@ -0,0 +1,25 @@ +\ ******************************************************************* +\ * +\ Filename: free.txt * +\ Date: 06.01.2014 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* + +\ MCU with eeprom +: .free + cr ." Flash:" flash hi here - u. ." bytes" + cr ." Eeprom:" eeprom hi here - u. ." bytes" + cr ." Ram:" ram hi here - u. ." bytes" +; + +\ MCU without eeprom +: .free + decimal + cr ." Flash:" flash hi here - u. ." bytes" + cr ." Ram:" ram hi here - u. ." bytes" +; + diff --git a/forth/forth/help.fs b/forth/forth/help.fs new file mode 100644 index 0000000..8128b6a --- /dev/null +++ b/forth/forth/help.fs @@ -0,0 +1,68 @@ +\ ******************************************************************* +\ * +\ Filename: help.txt * +\ Date: 03.03.2014 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +-help +marker -help +ram hex + +$1b constant esc +$09 constant tab +$0d constant ret +$0a constant nl + +flash hi $32ff - constant ahelp \ Start of help text area +ram + +: h= ( caddr caddr1 u -- flag ) + swap !p>r + for + c@+ pc@ p+ - + if drop false rdrop r>p exit then + next + r>p drop true +; + + +: .help ( addr -- ) + cr + begin + c@+ dup emit ret = + until + cr drop +; +: help ( "name" -- ) + bl word \ addr + dup c@ 0= if words abort then + ahelp !p>r + begin + busy pause idle + @p over c@+ h= if @p .help r>p drop exit then + begin + pc@ ret = pc@ nl = or + p+ + pc@ ret <> pc@ nl <> and + and + until + pc@ [char] | = + until + r>p drop +; + +: loadhelp ( -- store help info ) + ahelp !p>r \ Help info stored here + begin + key + dup emit + dup pc! p+ + [char] | = + until + r>p +; + diff --git a/forth/forth/helpwords.fs b/forth/forth/helpwords.fs new file mode 100644 index 0000000..4fd0005 --- /dev/null +++ b/forth/forth/helpwords.fs @@ -0,0 +1,255 @@ +loadhelp +! x addr -- Store x to addr +!p addr -- Store addr to p(ointer) register +!p>r addr -- Compile Only. Push contents of p to return stack and stor addr to p +# u1 -- u2 Compile Only. Convert 1 digit to formatted numeric string +#> u1 -- c-addr u Compile Only. Leave address and count of formatted numeric string +#s u1 -- u2 Compile Only Convert remaining digits to formatted numeric output +' -- xt Parse word and find it in dictionary +'source -- a-addr User Variable Current input source +( -- Skip input on the same line until ) is encountered +* u1/n1 u2/n2 -- u3/n3 Signed and unsigned 16*16->16 bit multiplikation ++ n1 n2 -- n3 Add n1 to n2 ++! n addr -- Add n to cell at addr +, x -- Append x to the current data section +- n1 n2 -- n3 Subtract n2 from n1 +. n -- Display n signed according to base +.s -- Display the stack contents +.st -- Emit status string for base, current data section, and display the stack contents +/ n1 n2 -- n3 16/16->16 bit division +/string addr u n -- addr+n u-n Trim string +0< n -- flag Leave true flag if n is less than zero +0= x -- flag Leave true flag if x is zero +1 -- 1 +1+ n -- n1 Add one to n +1- n -- n1 Subtract 1 from n +2* u1 -- u2 Shift u1 left one bit +2+ n -- n1 Add two to n +2- n -- n1 Subtract 2 from n +2/ n1 -- n2 Shift n1 right one bit. +2@ a-addr -- x1 x2 Fetch two cells +2! x1 x2 a-addr -- Store two cells +2drop x1 x2 -- Drop two cells +2dup x1 x2 -- x1 x2 x1 x2 Duplicate two top cells +: "name" -- Begin a colon definition +:noname -- addr Define headerless forth code +; -- Compile Only. End a colon definition +;i -- Compile Only. End a interrupt word +< n1 n2 -- flag Leave true flag if n1 is less than n2 +<# -- Compile Only. Begin numeric conversion +<> x1 x2 -- flag Leave true flag if x1 and x2 are not equal += x1 x2 -- flag Leave true flag if x1 and x2 are equal +> n1 n2 -- flag Leave true flag if n1 is grater than n2 +>body xt -- a-addr Leave the parameter field address of a created word +>digit n -- c Convert n to ascii character value +>in -- a-addr User Variable. Holds offset into tib +>number n1 addr1 u1 -- n2 addr2 u2 Convert string to number +>r x -- R: -- x Compile Only. Push x from the parameter stack to the return stack +?abort flag c-addr u -- Print message and abort if flag is true +?abort? flag -- If flag is true, emit ? and abort +?negate n1 n2 -- n3 Negate n1 if n2 is negative +@ addr -- x Fetch x from addr +@+ addr1 -- addr2 x Fetch cell from addr1 and increment addr1 by a cell +@p -- addr Fetch the p register to the stack +@ex addr -- Fetch vector from addr and execute. +[ -- Enter interpreter state +['] "name" -- Compile Only. Compile xt of name as a literal +[char] "char" -- Compile Only. Compile inline ascii character +[i -- Compile Only. Enter Fort interrupt context +\ -- Skip rest of line +] -- Enter compilation state +abort -- Reset stack pointer and execute quit +abort" "string" -- Compile Only. Compile inline string and postpone abort? +abs n -- n1 Leave absolute value of n +accept c-addr +n -- +n' Get line from terminal +again addr -- Compile Only. begin ... again +align -- Align the current data section dictionary pointer to cell boundary +aligned addr -- a-addr Align addr to a cell boundary. +allot n -- Adjust the current data section dictionary pointer +and x1 x2 -- x3 Bitwise and of x1 and x2 +base a-addr User Variable. Numeric conversion base +begin -- a-addr Compile Only. Begin loop definition +bin -- Set base to binary +bl -- c Ascii space +c! c addr -- Store c to addr +c@ addr -- c Fetch c from addr +c@+ addr1 -- addr2 c Fetch char from addr1 and increment addr1 +c, c -- Append c to the current data section +cell -- n Leave the size of one cell in characters. +cell+ addr1 -- addr2 Add cell size to addr1 +cells x1 -- x2 Convert cells to address units. +char "char" -- n Parse a char and leave ascii value on stack +char+ c-addr1 -- c-addr2 Add one to c.addr1 +chars x1 -- x2 Convert characters to address units +cf, xt -- Compile xt into the flash dictionary. +cfa>nfa addr1 -- addr2 Convert cfa to nfa +cmove addr1 addr2 u -- Move u chars from addr1 to addr2 +cold -- Make a cold start. Reset all dictionary pointers. +con x "name" -- Create a constant in rom as inline code +constant x "name" -- Create an constant in rom with docreate as runtime +cr -- Emit CR LF +create "name" -- Create a word definition and store the current data section pointer. +cse -- addr Ram variable holding the current data section value +cwd -- Clear the WatchDog counter. +decimal -- Set numeric base to decimal 10. +defer "name -- Define a deferred execution vector +di -- Disable interrupts +digit? c -- n flag Convert char to a digit according to base +does> -- Compile Only. Define the runtime action of a created word. +dp -- addr Eeprom variable mirrored in ram. Dictionary pointer +drop x1 -- Drop top of stack +dump addr u -- Display a memory dump +dup x -- x x Duplicate top of stack +ei -- Enable interrupts +end task-addr -- Remove a task from the task list. +eeprom -- Set data section context to eeprom +else addr1 -- addr2 Compile Only. if ... else ... then +emit c -- Emit c to the serial port FIFO. FIFO is 46 chars. Executes pause. +evaluate c-addr n -- Evaluate ram buffer +execute addr -- Execute word at addr +exit -- Exit from a word. +false -- 0 +flash -- Set data section context to flash +fill c-addr u c -- Fill u bytes with c staring at c-addr +find c-addr -- c-addr 0/1/-1 Find a word in dictionary. Leave 1 if immediate, -1 if normal, 0 if not found +for u -- Compile Only. Loop u times. for ... next +forget "name -- Forget name +here -- addr Leave the current data section dictionary pointer +hex -- Set numeric base to hexadecimal +hold c -- Compile Only. Append char to formatted numeric string +hp -- a-addr User Variable. Hold pointer for formatted numeric output +i] -- Compile Only. Exit Fort interrupt context +i, x -- Append x to the flash data section. +ic, c -- Append c to the flash data section. +if -- a-addr Compile Only. if ... else ... then +iflush -- Flush the flash write buffer +immed? addr -- n Leave a nonzero value if addr contains a immediate flag +immediate -- Mark latest definition as immediate +in? nfa -- flag Leave true flag if nfa has inline bit set +inline "name" -- Inline the following word. +inlined -- Mark the latest compiled word as inlined. +interpret c-addr u -- Interpret the ram buffer +invert x1 -- x2 ) Ones complement of x1 +irq -- a-addr Ram value. Interrupt vector. Cleared at warm start +is x "name" -- Set the value a deferred word +key -- c Get a character from the serial port FIFO. Execute pause until a character is available +key? -- flag Leave true if character is waiting in the serial port FIFO +khz -- u Leave the cpu clock in KHz +latest -- a-addr Variable holding the address of the latest defined word +leave -- Compile only. Leave a for/next loop when next is encountered. Sets top of return stack to zero +literal x -- Compile a literal into the dictionary +lshift x1 u -- x2 Shift x1 u bits to the left +m+ d1 n -- d2 Add double number d1 to n +marker "name" -- Mark a dictionary state +max n1 n2 -- n3 Leave max of n1 and n2 +mclr mask caddr -- AND the contents of ram-caddr with the complement of mask +min n1 n2 -- n3 Leave min of n1 and n2 +ms +n -- Pause for +n milliseconds +mset mask caddr -- OR the contents of ram-caddr with mask. +mtst mask caddr -- x AND the contents of ram-caddr with mask +n= caddr nfa u -- flag Compare strings in ram(c-addr) and flash(nfa) flag is true if strings match. u<32. +negate n -- -n negate n +next bra-addr bc-addr -- Compile Only. for ... next +nfa>lfa addr1 -- addr2 Convert nfa to lfa +nip x1 x2 -- x2 Remove x1 from the stack +number? caddr -- n/caddr flag Convert string to number, # is decimal prefix, $ is hexadecimal prefix, % is binary prefix +operator -- addr Leave the address of the operator task +or x1 x2 -- x3 Or bitwise x1 with x2 +over x1 x2 -- x1 x2 x1 Copy x1 to top of stack +p+ -- Increment P by one +p2+ -- Add 2 to P +p++ n -- Add n to P +p! x -- Store x to the location pointed by P +pc! c -- Store c to the location pointed by P +p@ -- x Fetch the cell pointed by P +pc@ -- c Fetch the char pointed by P +pad -- a-addr : pad ram here $20 + ; +pause -- Switch task +place addr1 u addr2 -- Place string from addr1 to addr2 as a counted string +postpone "name" -- Compile Only. Postpone action of immediate word +prompt -- a-addr Deferred execution vector for the info displayed by quit. ' .st is defer +quit -- Interpret from keyboard +r> -- x R: x -- Compile Only. Pop x from the return stack to the parameter stack +r>p -- R: x -- Compile Only. Pop from return stack to p register +r@ -- x R: x -- x Compile Only. Copy x from the return stack to the parameter stack +ram -- Set data section context to ram +rcnt -- a-addr User Variable. Number of saved return stack cells +rdrop -- R: x -- Compile Only. Remove top element from return stack +repeat addr2 addr1 -- Compile Only. begin ... while ... repeat +rhere -- addr Start of free ram +rot x1 x2 x3 -- x2 x3 x1 Rotate three top stack items +rsave -- a-addr User variable. Return stack save area +rshift x1 u -- x2 Shift x1 u bits to the right +run task-addr -- Link the task to the task list. The task starts running immediately. +s0 -- a-addr Variable for start of parameter stack +scan c-addr u c -- c-addr' u' Scan string until c is found. c-addr must point to ram. u<255 +sign n -- Append minus sign to formatted numeric output +sign? addr1 n1 -- addr2 n2 flag Get optional minus sign +single -- End all tasks except the operator task. +skip c-addr u c -- c-addr' u' Skip string until c not encountered. c-addr must point to ram. u<255 +sp@ -- addr Leave parameter stack pointer +sp! addr -- Set the parameter stack pointer to addr +s" "text" -- Compile Only. Compile string into flash +." "text" -- Compile Only. Compile string to print into flash +source -- c-addr n Current input buffer +space -- Emit one space character +spaces n -- Emit n space characters +ssave -- a-addr User Variable. Saved return stack pointer +state -- a-addr User Variable. Compilation state +swap x1 x2 -- x2 x1 Swap two top stack items +task: tibsize stacksize rstacksize addsize -- Define a task +tinit taskloop-addr task-addr -- Initialise the user area and link it to a task loop +then addr -- Compile Only. if ... else ... then +tib -- addr User variable. Terminal input buffer +ti# -- n Size of terminal input buffer. Task constant +ticks -- u System ticks. One ms resolution +to x "name" -- Store x into value "name". +true -- -1 +tuck x1 x2 -- x2 x1 x2 Insert x2 below x1 in the stack +turnkey -- a-addr Eeprom value mirrored in ram. Vector for user startup word +type c-addr u -- Type line to terminal. u < $100 +u*/mod u1 u2 u3 -- u4(remainder) u5(quotient) Unsigned u1*u2/u3 with 32 bit intermediate result +u. u -- Display u unsigned according to numeric base +u.r u +n -- Display u in field of width n. 016 bit division +u/mod u1 u2 -- u3(remainder) u4(quotient) Unsigned 16/16->16 bit division +u< u1 u2 -- flag Leave true flag if u1 is less than u2 +u> u1 u2 -- flag Leave true flag if u1 is greater than u2 +ulink -- a-addr USER. Link to next task +um* u1 u2 -- ud Unsigned 16x16 -> 32 bit multiply +um/mod ud u1 -- u2(remainder) u3(quotient) unsigned 32/16 -> 16 bit division +umax u1 u2 -- u Leave the unsigned larger of u1 and u2. +umin u1 u2 -- u Leave the unsigned smaller of u1 and u2. +until flag -- Compile only. begin..until +up -- a-addr Variable holding the user pointer +user n "name" -- Define a user variable at offset n +value x "name" -- Define a value +variable "name" -- Create a variable in the current data section +warm -- Make a warm start +while addr1 -- addr2 addr1 Compile Only. begin ... while ... repeat +within x xl xh -- flag Leave true if xl <= x < xh +word c -- c-addr Copy a word delimited by c to c-addr +words -- List words +xor x1 x2 -- x3 Xor bitwise x1 with x2. +btfsc, f b a -- +btfss, f b a -- +bcf, f b a -- +bsf, f b a -- +andlw, k -- +movf, f d a -- +a, -- 0 +w, -- 0 +call, addr -- +goto, addr -- +rcall, rel-addr -- +bra, rel-addr -- +z, -- cc +nz, -- cc +not, cc -- not-cc +if, cc -- here +else, back-addr -- here +then, back-addr -- +begin, -- here +again, back-addr -- +until, back-addr cc -- +| diff --git a/forth/forth/i2c-detect.fs b/forth/forth/i2c-detect.fs new file mode 100644 index 0000000..57b6011 --- /dev/null +++ b/forth/forth/i2c-detect.fs @@ -0,0 +1,54 @@ +\ i2c-detect.txt +\ Detect presence of all possible devices on I2C bus. +\ Only the 7 bit address schema is supported. +\ +\ Copied from amForth distribution (lib/hardware/) +\ and lightly edited to suit FlashForth 5.0 on AVR. +\ Builds upon i2c-base. +\ Peter J. 2014-10-27 +\ Mikael N. 2017-5-12 for..next instead of do..loop +-i2c-detect +marker -i2c-detect + +\ not all bitpatterns are valid 7bit i2c addresses +: i2c.7bitaddr? ( a -- f) $7 $78 within ; + +: i2c.detect ( -- ) + i2c.init + base @ hex + \ header line + cr 5 spaces 0 $10 for dup 2 u.r 1+ next drop + 0 $80 for + dup $0f and 0= if + cr dup 2 u.r [char] : emit space + then + dup i2c.7bitaddr? if + dup i2c.ping? if \ does device respond? + dup 2 u.r + else + ." -- " + then + else + ." " + then + 1+ + next drop + i2c.stop + cr base ! +; + +\ With a lone Microchip TC74A0 sitting on the bus, +\ the output looks like +\ ok<$,ram> +\ i2c.detect +\ 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f +\ 00 : -- -- -- -- -- -- -- -- -- +\ 10 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 20 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 30 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 40 : -- -- -- -- -- -- -- -- 48 -- -- -- -- -- -- -- +\ 50 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 60 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 70 : -- -- -- -- -- -- -- -- +\ ok<$,ram> + diff --git a/forth/forth/jmptbl-test.fs b/forth/forth/jmptbl-test.fs new file mode 100644 index 0000000..a49b1d9 --- /dev/null +++ b/forth/forth/jmptbl-test.fs @@ -0,0 +1,70 @@ +\ ********************************************************************* +\ * +\ Filename: jmptbl-test.txt * +\ FlashForth: 5.0 * +\ * +\ Author: Pete Zawasky * +\ Created: Tuesday, January 15 2008 - 18:50 ppz * +\ Last Edit Tuesday, January 29 2008 - 12:25 ppz * +\ * +\ ********************************************************************* +\ Based on jt.fth by Mikael Nordman, Jump_Table by Haskell * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License * +\ ********************************************************************* + +hex + +\ Create an execution table with n entries. +\ Each entry consists of 'nn' cell sized comparison value +\ and 'an' the address of the corresponding word to be executed. +\ At least two entries must be provided, the last one being the +\ default action. +\ +\ Jump Table (from Haskell) +\ Example: +\ +\ JUMP_TABLE do.key +\ control H | bkspace +\ control Q | quit +\ HEX 2B | escape DECIMAL +\ DEFAULT | chrout +\ Useage: +\ do.key ( n -- ) \ enter with n=code-to-match on TOS +\ + +\ ********************************************************************* +hex ram + +: .1st ( -- ) + ." First " +; + +: .2nd ( -- ) + ." Second " +; + +: .3rd ( -- ) + ." Third " +; + +: .4th ( -- ) + ." Default " +; + +jumptable do_test + $00 | .1st + $01 | .2nd + $02 | .3rd + default| .4th + +ram +1 do_test +2 do_test +9 do_test + +\ 1 do_test Second ok <16,2> +\ 2 do_test Third ok <16,2> +\ 9 do_test Default ok <16,2> + + diff --git a/forth/forth/jmptbl.fs b/forth/forth/jmptbl.fs new file mode 100644 index 0000000..764f20f --- /dev/null +++ b/forth/forth/jmptbl.fs @@ -0,0 +1,76 @@ +\ ********************************************************************* +\ * +\ Filename: jmptbl.txt * +\ FlashForth: 5.0 * +\ Application: FP * +\ * +\ Author: Pete Zawasky * +\ Created: Tuesday, January 15 2008 - 18:50 ppz * +\ Last Edit Tuesday, January 29 2008 - 12:25 ppz * +\ * +\ ********************************************************************* +\ Based on jt.fth by Mikael Nordman, Jump_Table by Haskell * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License * +\ ********************************************************************* + +-jmptbl +marker -jmptbl + +hex + +\ Create an execution table with n entries. +\ Each entry consists of 'nn' cell sized comparison value +\ and 'an' the address of the corresponding word to be executed. +\ At least two entries must be provided, the last one being the +\ default action. +\ +\ Jump Table (from Haskell) +\ Example: +\ +\ JUMP_TABLE do.key +\ control H | bkspace +\ control Q | quit +\ HEX 2B | escape DECIMAL +\ DEFAULT| chrout +\ Useage: +\ do.key ( n -- ) \ enter with n=code-to-match on TOS +\ + +\ Create a jump table. +\ +: jumptable ( -- ) \ compile an execution table + ( m -- ) \ execute a word corresponding to m + flash \ The jumptable goes into flash + create + here 0 , \ initial test_cnt stored at pfa + \ ( addr -- ) + does> \ ( m addr -- ) + dup @ \ ( m a cnt -- ) + for + cell+ + 2dup @ = \ ( m a flag -- ) + if \ a match was found + nip cell+ @ex \ execute the matched word + rdrop exit \ and exit + then + cell+ \ ( m a -- ) point to next nn to test + next + nip cell+ @ex \ execute the default word +; + +\ Use the words | and default| to fill jump table. +\ +: | ( addr nn -- addr ) + , ' , \ store m (match) and cfa in table + 1 over +! \ increment test_cnt at pfa +; + +: default| ( addr -- ) + drop ' , \ store default word cfa in table +; + +ram + + + diff --git a/forth/forth/jt-test.fs b/forth/forth/jt-test.fs new file mode 100644 index 0000000..9bda3b5 --- /dev/null +++ b/forth/forth/jt-test.fs @@ -0,0 +1,9 @@ +\ example +-tf +marker -tf +: .default ." no match " ; +flash +' .default 0 ' true 9 ' false 5 3 jt tf +ram +5 tf +9 tf diff --git a/forth/forth/jt.fs b/forth/forth/jt.fs new file mode 100644 index 0000000..496a439 --- /dev/null +++ b/forth/forth/jt.fs @@ -0,0 +1,42 @@ +\ ********************************************************************* +\ * +\ Filename: jt.txt * +\ Date: 06.01.2014 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ create an execution table with n entries +\ each entry consists of 'nn' cell sized comparison value +\ and 'an' the address of the corresponding word to be executed. +\ At least two entries must be provided, the last one beeing the +\ default action. +-jt +marker -jt + +: jte nip cell+ @ex ; +: jt ( an nn n -- ) \ compile an execution table + ( m -- ) \ execute aword corresponding to m + create + dup 1- , \ store the table size + for + , , \ store an entry + next + does> \ m addr + dup @ \ m a n + for + cell+ + 2dup @ = \ m a flag + if + \ a match was found + jte rdrop exit + then + cell+ \ m a + next + \ Execute the default action. + cell+ jte +; +ram + diff --git a/forth/forth/math.fs b/forth/forth/math.fs new file mode 100644 index 0000000..1657af7 --- /dev/null +++ b/forth/forth/math.fs @@ -0,0 +1,79 @@ +\ ********************************************************************* +\ * +\ Filename: math.txt * +\ Date: 31.12.2013 * +\ FF Version: 5.0 * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Double, triple and mixed math words + +: m* ( n1 n2 -- d ) + 2dup xor >r + abs swap abs um* + r> ?dnegate +; + +: sm/rem ( d1 n1 -- n2 n3 ) + 2dup xor >r over >r + abs >r dabs r> um/mod + swap r> ?negate + swap r> ?negate +; + +: fm/mod ( d1 n1 -- n2 n3 ) + dup >r + 2dup xor >r + >r + dabs r@ abs um/mod + swap r> ?negate swap + r> 0< if + negate + over if + r@ rot - swap 1- + then + then + r> drop +; +: /mod ( n1 n2 -- n3 n4 ) + >r s>d r> sm/rem +; +: mod ( n1 n2 -- n3 ) + /mod drop +; + +: */mod ( n1 n2 n3 -- n4 n5 ) + >r m* r> sm/rem +; +: */ ( n1 n2 n3 -- n4 ) + >r m* r> sm/rem nip +; + +\ multiply single number with double number. +\ Triple precision (48-bit) result +: ut* ( ud u -- ut) + dup >r swap >r um* r> r> um* >r + 0 swap 0 d+ r> + +; + + +\ Divide triple number with single number +\ Double result +: ut/ ( ut u -- ud) + dup >r um/mod r> swap >r + um/mod swap drop r> +; + +\ Scale with triple number intermediate result +: um*/ ( ud1 u1 u2 -- ud2) + >r ut* r> ut/ +; +\ Signed scale d1*n1/n2 with intermediate triple result +: m*/ ( d1 n1 n2 -- d2 ) + rot dup >r rot rot 2dup xor r> xor >r \ save result sign + abs >r abs >r dabs r> r> \ now have S:ud1 u1 u2 + um*/ r> ?dnegate +; + diff --git a/forth/forth/sieve.fs b/forth/forth/sieve.fs new file mode 100644 index 0000000..c5e3cd5 --- /dev/null +++ b/forth/forth/sieve.fs @@ -0,0 +1,43 @@ +\ ******************************************************************* +\ * +\ Filename: sieve.txt * +\ Date: 31.12.2013 * +\ FF Version: 5.0 * +\ MCU: PIC 18 24 30 33 Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ This normal sieve requires 8 KBytes of RAM. +\ It will not run on most PICs due to lack of memory. +\ sieve2 requires 1 Kbyte of RAM. + +-sieve +marker -sieve +decimal ram +8191 constant size inlined +ram align here size allot constant flags inlined +: sieve + flags size 1 fill + 0 1 !p>r size 1- + for + flags @p + c@ + if + @p dup + 3 + + dup @p + + begin + dup size < + while + 0 over flags + c! + over + + repeat + drop drop 1+ + then + p+ + next + r>p + . ." primes " cr ; + +: bench ticks sieve ticks swap - u. ." milliseconds" cr ; + diff --git a/forth/forth/sieve2.fs b/forth/forth/sieve2.fs new file mode 100644 index 0000000..87911c2 --- /dev/null +++ b/forth/forth/sieve2.fs @@ -0,0 +1,59 @@ +\ ******************************************************************* +\ * +\ Filename: sieve2.txt * +\ Date: 22.02.2014 * +\ MCU: PIC 18 24 30 33 Atmega * +\ Copyright: Mikael Nordman * +\ Author: Mikael Nordman * +\ ******************************************************************* +\ FlashForth is licensed according to the GNU General Public License* +\ ******************************************************************* +\ sieve2 requires 1 Kbyte of RAM. +-sieve2 +marker -sieve2 +decimal ram + + ( addr n c -- ) \ fill addr to addr+n with c +: fill rot !p>r swap for dup pc! p+ next r>p drop ; + +8192 constant size2 +ram variable flags2 size2 8 / allot +: bit-addr ( addr bit -- eff-addr ) + 3 rshift ( -- addr off) + + ( -- eff-addr) ; + +: bit? ( addr bit -- f ) + swap over bit-addr swap ( -- eff-addr bit ) + 7 and 1 swap lshift ( -- eff-addr bitmask) + swap c@ and ( -- f) ; + +: bit-reset ( addr bit -- ) + swap over bit-addr swap ( -- eff-addr bit ) + 7 and 1 swap lshift ( -- eff-addr bitmask) + invert over c@ and swap c! ; + +: sieve2 + flags2 [ size2 8 / ] literal -1 fill + 0 0 !p>r size2 + for + flags2 @p bit? + if + @p 2* 3 + + dup @p + + begin + dup size2 u< + while + flags2 over bit-reset + over + + repeat + 2drop 1+ + then + p+ + next + r>p . ." primes " cr +; + +: bench2 ticks sieve2 ticks swap - u. ." milliseconds" cr ; + +bench2 + diff --git a/forth/forth/tc74-app.fs b/forth/forth/tc74-app.fs new file mode 100644 index 0000000..db7db9b --- /dev/null +++ b/forth/forth/tc74-app.fs @@ -0,0 +1,40 @@ +\ Read temperature from TC74 on I2C bus. +\ Requires i2c-base.txt to be previously loaded. +\ Modelled on Mikael Nordman's i2c_tcn75.txt. +\ Peter J. 2014-10-28 + +-tc74-app +marker -tc74-app + +%1001000 constant addr-TC74A0 + +: tc74-init ( -- ) + \ Selects temperature register for subsequent reads. + addr-TC74A0 i2c.addr.write if 0 i2c.c! drop then i2c.stop +; + +: sign-extend ( c -- n ) + \ If the TC74 has returned a negative 8-bit value, + \ we need to sign extend to 16-bits with ones. + dup $7f > if $ff80 or then +; + +: degrees@ ( -- n ) + \ Wake the TC74 and fetch its register value. + addr-TC74A0 i2c.addr.read if i2c.c@.nack else 0 then i2c.stop + sign-extend +; + +: tc74-main ( -- ) + i2c.init + tc74-init + begin + degrees@ . + #1000 ms + key? until +; + +\ Now, report temperature in degrees C +\ while we warm up the TC74 chip with our fingers... +\ +\ decimal tc74-main 23 23 23 23 23 23 23 24 24 24 25 25 26 26 26 26 26 27 diff --git a/forth/forth/vt100-test.fs b/forth/forth/vt100-test.fs new file mode 100644 index 0000000..e3982c4 --- /dev/null +++ b/forth/forth/vt100-test.fs @@ -0,0 +1,36 @@ +\ ********************************************************************* +\ +\ Filename: vt100-test.txt +\ Date: 02.03.2014 +\ FF Version: 5.0 +\ Author: Attila Herman +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Frequently used commands for VT100 compatible terminals +\ Unfortunately there is some differencies between terminal emulators! +\ Maybe some words doesn't work, or does another function depending on +\ terminal. + +-vt100-test +marker -vt100-test + +: vt100-test + \cls \c- + 2 8 \cp + \bri s" *** " type + \res \rev s" Terminal test " type \res + \bri s" ***" type + 6 8 \cp \unl s" ^^^^^^^^^^^^^^^^^^^^^^" type + 8 8 \cp \res s" Press any key to quit! " type + \res \bri \rev + 0 + begin + 4 #16 \cp bl emit + dup . 1+ s" sec " type + #1000 ms + key? + until + key 2drop \res 5 \cdn \nl \c+ +; + diff --git a/forth/forth/vt100.fs b/forth/forth/vt100.fs new file mode 100644 index 0000000..74bda6b --- /dev/null +++ b/forth/forth/vt100.fs @@ -0,0 +1,55 @@ +\ ********************************************************************* +\ +\ Filename: vt100.txt +\ Date: 02.03.2014 +\ FF Version: 5.0 +\ Author: Attila Herman +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License* +\ ********************************************************************* +\ Frequently used commands for VT100 compatible terminals +\ Unfortunately there is some differencies between terminal emulators! +\ Maybe some words doesn't work, or does another function depending on +\ terminal. + +-vt100 +marker -vt100 + +\ Auxiliary words +: esc[ #27 emit #91 emit ; \ 'esc' and '[' for starting escape sequence +: .n ( n -- ) \ Print n without separator space character + 0 <# #s #> for dup c@ emit 1+ next drop ; +: \; [char] ; emit ; \ Emit semicolon character + +\ Erasing and cursor positioning words +: \h esc[ [char] H emit ; \ Cursor to home position +: \cls esc[ [char] 2 emit [char] J emit ; \ Clear the screen +: \clsh \cls \h ; \ cls + home +: \el esc[ [char] 2 emit [char] K emit ; \ Erase line +: \esl esc[ [char] 1 emit [char] K emit ; \ Erase from start of line +: \eel esc[ [char] 0 emit [char] K emit ; \ Erase to end of line +: \nl esc[ [char] E emit ; \ Next line +: \cu esc[ [char] A emit ; \ Cursor up +: \cun esc[ .n [char] A emit ; \ Cursor up with n line +: \cd esc[ [char] B emit ; \ Cursor down +: \cdn esc[ .n [char] B emit ; \ Cursor down with n line +: \cf esc[ [char] C emit ; \ Cursor foreward +: \cfn esc[ .n [char] C emit ; \ Cursor foreward with n position +: \cb esc[ [char] D emit ; \ Cursor backward +: \cbn esc[ .n [char] D emit ; \ Cursor backward with n position +: \cp esc[ swap .n \; .n [char] f emit ; \ Cursor position to line, row +: \t 9 emit ; \ Cursor to next tab position + +\ Attributes +: \attr esc[ .n [char] m emit ; \ Set the current attribute +: \res 0 \attr ; \ Reset attributes to default +: \bri 1 \attr ; \ Bright +: \unl 4 \attr ; \ Underline +: \bli 5 \attr ; \ Blinked +: \rev 7 \attr ; \ Reverse +: \hid 8 \attr ; \ Hidden + +\ Cursor on/off +: \c+ esc[ [char] ? emit [char] 2 emit [char] 5 emit [char] h emit ; +: \c- esc[ [char] ? emit [char] 2 emit [char] 5 emit [char] l emit ; + diff --git a/forth/main.fs b/forth/main.fs deleted file mode 100644 index bfbf81e..0000000 --- a/forth/main.fs +++ /dev/null @@ -1,34 +0,0 @@ --io -marker -io \ define ports - -$0023 constant PB -$0023 constant pinb -$0024 constant ddrb -$0025 constant portb - -$0026 constant PC -$0026 constant pinc -$0027 constant ddrc -$0028 constant portc - -$0029 constant PD -$0029 constant pind -$002a constant ddrd -$002b constant portd - --init -marker init - -: bv ( bit -- mask ) 1 swap lshift ; -: pin ( bit base-addr -- ) bv swap 2dup 1+ mclr ; -: port ( bit base-addr -- ) bv swap 1+ 2dup mset 1+ ; -: set ( mask addr -- ) mset ; -: clr ( mask addr -- ) mclr ; -: init - PB #3 port 2constant servo - PB #5 port 2constant led - PD #2 pin 2constant sr - PD #3 pin 2constant sc - PD #4 pin 2constant sl -; -: get ( mask addr -- bool ) c@ invert and 0= ; diff --git a/forth/see.fs b/forth/see.fs deleted file mode 100644 index a1c2deb..0000000 --- a/forth/see.fs +++ /dev/null @@ -1,77 +0,0 @@ -\ ********************************************************************* -\ Filename: see.txt * -\ Date: 20.03.2017 * -\ FF Version: 5.0 * -\ MCU: Atmega * -\ Copyright: Mikael Nordman * -\ Author: Mikael Nordman * -\ ********************************************************************* -\ FlashForth is licensed acording to the GNU General Public License* -\ ********************************************************************* --see -marker -see -hex ram -: *@ dup @ ; -: u.4 4 u.r ; -: *@+ dup cell+ @ u.4 ; -: 5sp 5 spaces ; -: @braddr ( addr -- addr xt-addr ) - *@ fff and dup 800 and - if f800 or then 2* over + cell+ ; -: @xtaddr ( addr -- addr xt-addr ) - dup cell+ @ xa> ; -: .rjmp ( addr -- addr+2 ) @braddr u.4 cell+ ; -: .br ( addr -- addr+2 ) - *@ 3 rshift 7f and dup 40 and - if ff80 or then 2* over + cell+ u.4 cell+ ; -: .reg ( addr -- addr ) - dup @ 4 rshift 1f and ." r" decimal 2 u.r hex cell+ ; -: .ldi ( addr -- addr ) - *@ dup 4 rshift dup 000f and 0010 + - ." r" decimal 2 u.r hex - 00f0 and swap 000f and + 2 u.r cell+ ; -: ?call ( addr -- addr f ) *@ fe0e and 940e - ; -: ?ret ( addr -- addr f ) *@ 9508 - ; -: ?rcall ( addr -- addr f ) *@ f000 and d000 - ; -: ?jmp ( addr -- addr f ) *@ fe0e and 940c - ; -: ?rjmp ( addr -- addr f ) *@ f000 and c000 - ; -: ?breq ( addr -- addr f ) *@ fc07 and f001 - ; -: ?brne ( addr -- addr f ) *@ fc07 and f401 - ; -: ?brcc ( addr -- addr f ) *@ fc07 and f400 - ; -: ?pop ( addr -- addr f ) *@ fe0f and 900f - ; -: ?push ( addr -- addr f ) *@ fe0f and 920f - ; -: ?st-y ( addr -- addr f ) *@ fe0f and 920a - ; -: ?ldy+ ( addr -- addr f ) *@ fe0f and 9009 - ; -: ?ijmp ( addr -- addr f ) *@ 9409 - ; -: ?ldi ( addr -- addr f ) *@ f000 and e000 - ; -: (see) ( addr -- addr' | false ) - dup u.4 - *@ u.4 - ?call 0= if *@+ ." call " @xtaddr c>n .id cell+ cell+ else - ?rcall 0= if 5sp ." rcall " @braddr c>n .id cell+ else - ?breq 0= if 5sp ." breq " .br else - ?brne 0= if 5sp ." brne " .br else - ?brcc 0= if 5sp ." brcc " .br else - ?rjmp 0= if 5sp ." rjmp " .rjmp else - ?ijmp 0= if 5sp ." ijmp" drop false else - ?ret 0= if 5sp ." ret" drop false else - ?jmp 0= if *@+ ." jmp " @xtaddr c>n .id drop false else - ?pop 0= if 5sp ." pop " .reg else - ?push 0= if 5sp ." push " .reg else - ?ldy+ 0= if 5sp ." ld " .reg ." y+" else - ?st-y 0= if 5sp ." st -y " .reg else - ?ldi 0= if 5sp ." ldi " .ldi else - cell+ - then then then then then - then then then then then - then then then then - cr ; - -: dis ( addr -- ) - hex cr - begin (see) dup 0= - until drop ; - -: see ( "word" -- ) ' dis ; -hex ram - -- cgit v1.2.3