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 From d00a92eb232b03cc5e19a33c407c0f0efd50b784 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:00:43 +0200 Subject: ... --- ...VR-Microcontroller-ATmega328-328P_Datasheet.pdf | Bin 5418032 -> 0 bytes forth/depth.fs | 4 + ...VR-Microcontroller-ATmega328-328P_Datasheet.pdf | Bin 0 -> 5418032 bytes forth/docs/ff5-elements.pdf | Bin 0 -> 223242 bytes forth/docs/ff5-sheet.pdf | Bin 0 -> 171382 bytes forth/docs/ff5-tutorial-guide.pdf | Bin 0 -> 13376704 bytes forth/elegoo.fs | 23 + 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/ff5-elements.pdf | Bin 223242 -> 0 bytes forth/ff5-sheet.pdf | Bin 171382 -> 0 bytes forth/ff5-tutorial-guide.pdf | Bin 13376704 -> 0 bytes forth/ff_uno.hex | 531 -- forth/fib.fs | 5 + forth/firmware/config.inc | 117 + forth/firmware/ff-atmega.asm | 6092 ++++++++++++++++++++ forth/firmware/ff_uno.hex | 531 ++ forth/flash-led.fs | 23 + forth/main.fs | 34 + forth/rand.fs | 17 + forth/uno.fs | 138 + 26 files changed, 6984 insertions(+), 775 deletions(-) delete mode 100644 forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf create mode 100644 forth/depth.fs create mode 100644 forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf create mode 100644 forth/docs/ff5-elements.pdf create mode 100644 forth/docs/ff5-sheet.pdf create mode 100644 forth/docs/ff5-tutorial-guide.pdf create mode 100644 forth/elegoo.fs delete mode 100644 forth/elegoo/depth.fs delete mode 100644 forth/elegoo/elegoo.fs delete mode 100644 forth/elegoo/fib.fs delete mode 100644 forth/elegoo/flash-led.fs delete mode 100644 forth/elegoo/main.fs delete mode 100644 forth/elegoo/rand.fs delete mode 100644 forth/elegoo/uno.fs delete mode 100644 forth/ff5-elements.pdf delete mode 100644 forth/ff5-sheet.pdf delete mode 100644 forth/ff5-tutorial-guide.pdf delete mode 100644 forth/ff_uno.hex create mode 100644 forth/fib.fs create mode 100644 forth/firmware/config.inc create mode 100644 forth/firmware/ff-atmega.asm create mode 100644 forth/firmware/ff_uno.hex create mode 100644 forth/flash-led.fs create mode 100644 forth/main.fs create mode 100644 forth/rand.fs create mode 100644 forth/uno.fs diff --git a/forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf b/forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf deleted file mode 100644 index e98e8dc..0000000 Binary files a/forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf and /dev/null differ diff --git a/forth/depth.fs b/forth/depth.fs new file mode 100644 index 0000000..b4bb661 --- /dev/null +++ b/forth/depth.fs @@ -0,0 +1,4 @@ +-depth +marker -depth + +: depth s0 @ 2- sp@ - 2/ ; diff --git a/forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf b/forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf new file mode 100644 index 0000000..e98e8dc Binary files /dev/null and b/forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf differ diff --git a/forth/docs/ff5-elements.pdf b/forth/docs/ff5-elements.pdf new file mode 100644 index 0000000..d7ea390 Binary files /dev/null and b/forth/docs/ff5-elements.pdf differ diff --git a/forth/docs/ff5-sheet.pdf b/forth/docs/ff5-sheet.pdf new file mode 100644 index 0000000..918fa33 Binary files /dev/null and b/forth/docs/ff5-sheet.pdf differ diff --git a/forth/docs/ff5-tutorial-guide.pdf b/forth/docs/ff5-tutorial-guide.pdf new file mode 100644 index 0000000..2fb656d Binary files /dev/null and b/forth/docs/ff5-tutorial-guide.pdf differ diff --git a/forth/elegoo.fs b/forth/elegoo.fs new file mode 100644 index 0000000..f6d5391 --- /dev/null +++ b/forth/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/depth.fs b/forth/elegoo/depth.fs deleted file mode 100644 index b4bb661..0000000 --- a/forth/elegoo/depth.fs +++ /dev/null @@ -1,4 +0,0 @@ --depth -marker -depth - -: depth s0 @ 2- sp@ - 2/ ; diff --git a/forth/elegoo/elegoo.fs b/forth/elegoo/elegoo.fs deleted file mode 100644 index f6d5391..0000000 --- a/forth/elegoo/elegoo.fs +++ /dev/null @@ -1,23 +0,0 @@ --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 deleted file mode 100644 index 8f4cfbc..0000000 --- a/forth/elegoo/fib.fs +++ /dev/null @@ -1,5 +0,0 @@ --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 deleted file mode 100644 index 08fc643..0000000 --- a/forth/elegoo/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/elegoo/main.fs b/forth/elegoo/main.fs deleted file mode 100644 index bfbf81e..0000000 --- a/forth/elegoo/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/elegoo/rand.fs b/forth/elegoo/rand.fs deleted file mode 100644 index 2bd2447..0000000 --- a/forth/elegoo/rand.fs +++ /dev/null @@ -1,17 +0,0 @@ -\ 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 deleted file mode 100644 index bd70aa3..0000000 --- a/forth/elegoo/uno.fs +++ /dev/null @@ -1,138 +0,0 @@ --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/ff5-elements.pdf b/forth/ff5-elements.pdf deleted file mode 100644 index d7ea390..0000000 Binary files a/forth/ff5-elements.pdf and /dev/null differ diff --git a/forth/ff5-sheet.pdf b/forth/ff5-sheet.pdf deleted file mode 100644 index 918fa33..0000000 Binary files a/forth/ff5-sheet.pdf and /dev/null differ diff --git a/forth/ff5-tutorial-guide.pdf b/forth/ff5-tutorial-guide.pdf deleted file mode 100644 index 2fb656d..0000000 Binary files a/forth/ff5-tutorial-guide.pdf and /dev/null differ diff --git a/forth/ff_uno.hex b/forth/ff_uno.hex deleted file mode 100644 index b0ab0b3..0000000 --- a/forth/ff_uno.hex +++ /dev/null @@ -1,531 +0,0 @@ -:020000020000FC -:105F00000E94B93209C00E9408300E94EB320E9400 -:105F1000FA3311F00C9464390E94953AA0F70C946E -:105F200060390002A1024402F0F83EF97EF90A004D -:105F3000A50280DF000000000000000003028120B5 -:105F40000E9447310E94D837C2FE0E94DE320E9472 -:105F500019370E9481350E94D8370F000C942633E0 -:105F600000008465786974000F910F910895A4FA78 -:105F7000886F70657261746F72000E94E03080DF1C -:105F800003020000400060005A0062DF8469646C14 -:105F90006500706408958CDF8462757379007F7B7F -:105FA00008958CFE846D73657400FC01899199914C -:105FB0000081082B0083899199910895A4DF846D55 -:105FC000636C7200FC01899199910081809508238E -:105FD0000083899199910895BEDF866C7368696624 -:105FE0007400FC018991999131971AF0880F991FDB -:105FF000FBCF0895DADF8672736869667400FC016E -:106000008991999131971AF096958795FBCF0895CC -:1060100078D5A7D276D5A5C2F6DF826E3D00F8DF2F -:106020008F7079D3E7D3B1F03FD36BD5A2D20CC038 -:10603000EFDF6CD3DFD321F066D70E94A53A04C00E -:10604000ACD2D8D309F456D70E94953A88F71F915D -:106050000F9101C058D70FD40C943B341AE08473CD -:106060006B69700086D2CCD389F073D226D4A9D7BD -:106070009FD7090050D3BED329F48FD24CD3BAD3C3 -:1060800029F001C055D2C4D1E7D4EDCF0F910F91C3 -:1060900008955EE0847363616E0062D36AD210C0BB -:1060A00030D58FD785D7090036D3A4D311F040D28D -:1060B00005C00E94663B2FD39DD311F0F5D203C0DB -:1060C0000E94953A68F75FD2EAD255D3089594E0DA -:1060D000846D74737400FC0181910991199180237E -:1060E00099270895D0E0834663796AD0803E837310 -:1060F000703F89D00E940E399CD60E94093999D6EA -:10610000CED2FAD2D9D10353503F3ED70895E6E01C -:1061100084656D6974005ED30C94AB3010E1836BC1 -:1061200065795ED30C94AB301EE1846B65793F00DA -:106130005DD30C94AB302AE187657865637574652F -:10614000FC01F058899199918894F795E795099405 -:1061500038E1834065786DD60C94A03052E18876A2 -:1061600061726961626C65009CD0B1D0DAD10C9427 -:10617000CB305EE189327661726961626C6591D083 -:1061800017D70400CED10C94CB3074E188636F6EC6 -:106190007374616E7400D6D70E941D3E0C94B038A3 -:1061A0008CE18932636F6E7374616E74C8D1CAD723 -:1061B0000E941D3E0E941D3E0C94B0388328632926 -:1061C000FF91EF910CD0FF91EF91099483286429FE -:1061D000BF91AF91FF91EF9102D0FD0109949A9385 -:1061E0008A93EE0FFF1F85919591089583282C299E -:1061F000FF91EF91F4DFF795E795EF93FF9398C048 -:10620000A2E183737040FE019A938A93CF010895AF -:1062100083737021EC01089583727030BF91AF9148 -:106220000E940E3906D68DBF9EBF89919991FD01BE -:10623000099402E2B37270409A938A938DB79EB725 -:10624000089534E2A23E3C00082F892F902F089534 -:1062500044E285666C6173685092E501089552E2EC -:1062600086656570726F6D007092E501089560E259 -:106270008372616D04E00093E501089570E2826429 -:10628000700035D704D00C94DE32836373659A9323 -:106290008A938091E501992708957EE2846865726A -:1062A0006500EFDF0C94863E9CE2812CFADF37D448 -:1062B0000ED00C949132AAE282632C00F2DF01D35B -:1062C000A7D00C949132B8E28463656C6C009A9309 -:1062D0008A9382E090E00895C8E285616C69676EF8 -:1062E000E0DF08D0CEDF0C944C3EDAE287616C69C7 -:1062F000676E656401968E7F0895ECE2A563656C18 -:106300006C2B02960895FCE2A563656C6C73880F94 -:10631000991F089508E3A5636861722B019608959B -:1063200016E3A56368617273089522E38363662CA4 -:1063300048D674D650D13DD13BD6F00FF6D15AD2C3 -:1063400049F036D60E940E943E3F90588894979517 -:10635000879506C063D63FD13ED7BCD19F70906D64 -:106360000C943E3F82213A0023D6FAFF0C94C739A1 -:106370002CE38232400025D65CD5E1D0C2DF0C94FC -:10638000193772E382322100DAD0E3D0BADFC7D303 -:106390000C944C3E84E3853264726F70C9D00C94C7 -:1063A000983296E3843264757000D3D00C94A9328D -:1063B000A4E3853273776170D4D0DBD0D2D0E3D040 -:1063C0000895B2E38573706163650AD70C948B30CE -:1063D000C4E3867370616365730012D219F0F5DF50 -:1063E00063D1FBCF0C949832D2E384756D696E0053 -:1063F000DCDFA8D106C0EAE384756D617800D5DFE3 -:106400009AD1F8D109F09BD00C949832F8E38131FD -:106410009A938A9381E090E008950EE48661636325 -:106420006570740096D0CAD094D07BDE8D3029F48C -:106430006AD52FD046D27CD026C08A3049F478D095 -:1064400028D03BD2D7D1F9F055D523D03AD2EDCFD1 -:1064500051D51FD036D2B5D55EDEB3D5A9D508004B -:106460005AD1C8D139F064D01FD183D072D08BD02B -:10647000C6DFDBCF6ED025D212D16BD0B9DF95DF6E -:1064800045D1B8D191F6F7D15AD00C94EB3283664E -:106490006372CFD2F5FF1CE484747970650069D013 -:1064A00002C02FD338DE0E94953AD8F71F910F9182 -:1064B0000C94983283287322FF91EF91EE0FFF1F07 -:1064C00005919A938A93CF0190589A938A93802F3B -:1064D0009927E00FF91F31968894F795E79509946D -:1064E00098E4D273220084DEB8E4B6DE05D00C94C2 -:1064F0003A31E2E4822C22005BD52200C0D2D1DE08 -:1065000028D0CDD0F7DE0DD00C947835F4E4D22E1F -:106510002200E9DF6DDE9EE408950EE585616C6C76 -:106520006F74AFDE0C9470331CE5A464726F70005E -:106530008991999108952AE5847377617000099192 -:1065400019919A938A93C801089538E5846F766506 -:1065500072009A938A938A819B8108954CE5837295 -:106560006F7407D0ECDF0FD00C949F325EE5923E43 -:106570007200FF91EF918F939F9389919991099464 -:106580006EE592723E00FF91EF919A938A939F91EC -:106590008F91099482E592724000FF91EF919A9356 -:1065A0008A939F918F918F939F930994BEEF8361FC -:1065B000627307D50C944A34AEE5812B0991199189 -:1065C000800F911F0895BAE5826D2B00D0D70C94EF -:1065D000D93AC8E5812D09911991081B190BC801F9 -:1065E00008950090D7011090D8010895FADF009423 -:1065F0001094060C151C0BD001C008D0906521D05A -:10660000E0D4812D07D0806990641BC0EADFF7D603 -:10661000F6D6802D982F92958F709F708068089580 -:10662000F5DF90670ED0CDD4812DF4DF80699067BF -:1066300008C0ECDF906605D0C4D4812DEBDF806903 -:1066400090660C943E3FD4E583616E640991199184 -:1066500080239123089548E6826F72000991199171 -:10666000802B912B089558E683786F7209911991C8 -:1066700080279127089568E6A6696E766572740092 -:1066800080959095089578E6866E656761746500DB -:10669000809590950196089588E6A2312B00019689 -:1066A00008959AE6A2312D0001970895A4E6A2323A -:1066B0002B0002960895AEE6A53E626F64790496BB -:1066C0000895B8E6A2322A00880F991F0895C4E6FB -:1066D000A2322F00959587950895D0E6822B210050 -:1066E0002EDF37DFA6D36ADF2ADF0C944C3EDCE6D0 -:1066F0008677697468696E002CDF6DDF3ADF6BDFC7 -:1067000042DF0C949B33F0E6823C3E0004D00C94B4 -:10671000E737D8EF813D5FDF0C94E73714E7813C22 -:106720005ADF0C94EE371EE7813E09DF0C9490335C -:1067300028E782753C004FDF880B990B089532E7FC -:1067400082753E00FCDE0C949B3340E78221700092 -:10675000AC018991999108954CE79421703E7200A3 -:10676000FF91EF914F935F93AC01899199910994B7 -:106770005AE793723E70FF91EF915F914F910994A8 -:1067800072E7827040009A938A93CA010C94863E05 -:1067900082E7827021009A938A93CA010C944C3E3E -:1067A00092E7837063219A938A93CA010C94BB3E4B -:1067B000A2E7A2702B00460D551D0895B2E7837025 -:1067C0002B2B480F591F899199910895BEE7852772 -:1067D000656D69742ED1E8FFCEE784276B6579007B -:1067E00028D1EAFFDAE785276B65793F22D1ECFFF4 -:1067F000833F303D00978991999108958364303D9E -:1068000000970895E6E783756D2A0C94643F06E8C7 -:1068100086756D2F6D6F64000C947D3F10E8857553 -:106820002F6D6F6467D38BDE0C947D3F1EE8812A49 -:10683000ECDF0C9498322EE882752F00F3DF0C9475 -:106840003B3438E886752A2F6D6F640092DEDDDFF9 -:106850009ADE0C940C3444E8812FA7DD07DF89DE33 -:10686000A8DE6DDEA6DE6BDEE9DF8DDE0C944A3439 -:1068700058E8A36E697009910991089572E88474CB -:1068800075636B005CDE0C94A9327EE8873F6E6511 -:1068900067617465A3D3AEDF09F0FADE08958CE872 -:1068A000836D617882DD3CDFACCDA0E8836D696EDD -:1068B0007CDD3BDFA6CD826340000C94A13E826369 -:1068C00021000C94BB3EACE88275700079DC0200BC -:1068D000C8E884686F6C640016D392D001DF90D052 -:1068E000A8D20C94BB3ED2E8823C23008ED088D044 -:1068F0000C944C3EE8E88564696769748A300CF052 -:106900008796C0960895F6E8812387D092D282D1E7 -:1069100028DEF4DF0C946C3408E982237300F5DF81 -:1069200044DD9CDE67DFD9F708951AE982233E0033 -:1069300035DD66D07ED269D00CDE0C94EB322CE9CA -:10694000847369676E0090301AF432D32D00C4DF6F -:106950000C94983240E982752E00C8DFCBD2DFDF7D -:10696000E7DF9DDD0C94E53156E983752E72BEDFBD -:106970009BDEFFDDBFD201C0C8DFD7D5E8F71F918E -:106980000F91CDDFD5DF8BDD0C94E5316AE9812EE7 -:10699000ADDF17D30EDEAED2C2DFE3DDD4DFC8DF5A -:1069A0007EDD0C94E5318EE987646563696D616C09 -:1069B00079D233D00C944C3EA8E983686578F8D23C -:1069C00010002BD00C944C3EBAE98362696E7FDCD8 -:1069D00024D00C944C3ECAE985727361766529D047 -:1069E000FEFFD8E985756C696E6B23D0FCFFE4E986 -:1069F000847461736B001DD0F2FFF0E9826870004F -:106A000018D00000FCE9837061647BD172D10C94D2 -:106A1000DE3206EA8462617365000BD0EEFF14EA91 -:106A200084757365720017D352DC32DEB0D409DE90 -:106A300064D3FF91EF91D3DB820D931D089520EA7B -:106A400086736F75726365006ED10C94BB3140EA3A -:106A5000872F737472696E6772DD7BDDBCDD89DD43 -:106A6000ADDD91DD089550EAC15CEEDF55D157D020 -:106A700060640C94983268EA857061727365A1D283 -:106A8000E3DF4AD1D6D1E8DF8F939F936ADDEADA5C -:106A900060DD6FDD66DD01DBB3DE09F005DE73DD91 -:106AA00072DD5FDD98DD38D11BDEECDE0C94EB325D -:106AB00078EA84776F726400E2DF41DDF5DDE2DEC3 -:106AC0000C94BB3EB2EA85636D6F766538DD48DEB7 -:106AD00050DD03C016D067DE6EDE27D5D8F71F91D4 -:106AE0000F9149DE0C949832C6EA85706C6163653B -:106AF0005CDCE7DE13DC23DD0C946635EAEA8363B5 -:106B0000402B5FD2CCDD1BDD0C94A13EFEEA82401F -:106B10002B0057D2CEDD13DD0C94863E81210C94E0 -:106B20004C3E0EEB836E3E63ECDF8F7047DD0C94C2 -:106B30007A3124EB83633E6E4ED343D2BEDE0E9495 -:106B4000453E27FFC9F3089534EB832866292DDCE1 -:106B500066DA56DE21F0ECDC3ED36BD132D24ADE6F -:106B6000B1F74EDE41F087DE2CD2DEDFE8DC09D063 -:106B70002ED24EDC73DD08954AEB86696D6D656437 -:106B80003F009BDE982E807408957AEB8466696ED0 -:106B900064000ED2E6F6DBDF33DE21F4C9DC33D34A -:106BA00048D1D5DF08958CEB8664696769743F002E -:106BB00080340CF08797C0970AF49CC102D22DDF75 -:106BC00038D10C949033A8EB857369676E3FC1DCB4 -:106BD00074DE082FADDC0D3219F00B3219F003C052 -:106BE00004D091C102D00C947A3712DC0C942C356D -:106BF000C8EB8375642A8F939F9307DE99DC9FDC33 -:106C0000C2DC03DEAEDC0C94DE32F2EB8675642F60 -:106C10006D6F6400AEDC6ED1C0DCFEDDA2DCA1DCF9 -:106C2000B2DCFADD0C94B1320CEC873E6E756D620D -:106C3000657221E0E5DDD1F09CDC8F939F933DDE12 -:106C40008E3279F0B5DFD6DD21F472DC9CDC9BDC82 -:106C50000DC08FDCE2DEEDD0CEDF95DCB7DC20E0CE -:106C600001C066DC90DC8FDCC0DFE4CF820F0895CA -:106C70002AEC876E756D6265723FA3D13BD13AD124 -:106C800070DC3FDFA4DF75DCC8DED3D072DC61DCF2 -:106C900014DE8397833038F43ADB8AD13AFF8EDCF6 -:106CA0005ADAA3DF01C044DCC4DF6DDCB6DE37DFB7 -:106CB000A1DD29F068DC72DB71DB1CD111C001970A -:106CC000FCDD0E94453E5FDC95DD09F058D42E3294 -:106CD00021F447DC82E090E003C02ADCCCDD98DBC5 -:106CE00008958473776170000C949F3272EC837402 -:106CF000692381DE9ED008960C94863EEEEC837468 -:106D0000696205D00C94863EFEEC8374697591DE51 -:106D1000F0FF0AED833E696E8CDEFAFF14ED8727E3 -:106D2000736F7572636585DEF6FF4BD1FF91EF914E -:106D300056DAF795E795EFDC5DDD09941EED89697C -:106D40006E74657270726574EEDF1EDBD3D0E4DFA3 -:106D5000E6DEBDD645D2B0DE34D1AFDD4BDD09F481 -:106D600064C017DF4DDD09F445C099DC40D22FD156 -:106D700075DC40DD99F094FE0AC039D29DDB0C43EE -:106D80004F4D50494C45204F4E4C5900FDD06F7B24 -:106D9000D7D966FDDECF6F7E6F7D2AC06F7EC5DFDF -:106DA000CEEF11F0606120C067FF14C0BEDF4CE67B -:106DB00011F036DC1DC0B9DF5CE611F03ADC18C01A -:106DC000B4DFBCE511F012DC13C0AFDFD6E511F083 -:106DD00014DC0EC06F7DA9DFC2EF09F0606295FE82 -:106DE00003C00E946C3A04C025D16D7F94FC6260A0 -:106DF0006F77AFCF6F749CDB40DF02DD81F0F7D19E -:106E0000F9DC59F0082F8991999101FF03C06CDFDB -:106E10000E941D3E0E941D3E9CCF8ADBE9CF88DB8D -:106E200045D06FDE3CDB66D0A6D051D60C949832AC -:106E300081400C94863E3EED83736862E4D1F9DFB5 -:106E4000C0D03BDD8EDB0ADC4FDF0C94BB3E38EE5E -:106E500089696D6D656469617465AAD040000C94A0 -:106E60001E3750EE87696E6C696E6564A1D0200094 -:106E70000C941E3764EE832E73749AD03C004BD969 -:106E80000E94503F48D994D02C0045D90E94A02F91 -:106E900006DB8ED03E003FD90C948639823E7200CC -:106EA0000C94B9328DD90A008364703E81D00009F8 -:106EB000B9D1F8DF0C946635833E647079D000094F -:106EC0004FDCB0D175D0040054DB23DE7AD05BDC1C -:106ED0001DDC90DC11F05FDC01C02ADB06D425D379 -:106EE000A0F71F910F9147DC0C94983276EE8566DF -:106EF000616C73659A938A93882799270895EEEEBB -:106F00008474727565009A938A938FEF9FEF08954A -:106F100000EF84717569740081D90AD1ABD9C6DFDD -:106F2000E8D88DD0EEDE4DD0E4DE0A977BDA4DDA7C -:106F30000BDF5DD15FDCA1F7B9D5C0DFBDDA03207F -:106F40006F6BADDA07D00C948F3712EF8670726FCB -:106F50006D7074000E94F33E0A094CEF8561626F08 -:106F6000727457D166DF56D90C948C375CEF873F2B -:106F700061626F72743FA0DA013F0C94C4376EEF08 -:106F8000863F61626F727400ECDA34DC19F41DDA4A -:106F900086DAE7DF0C94CE3180EFD661626F7274CF -:106FA0002200A1DA25D988EF08959AEF836C6974DD -:106FB000FF91EF9114D9F795E795099496E5A364AD -:106FC00075709A938A93089508E782303D0001977F -:106FD000880B990B0895CAEF82303C00990F880BFB -:106FE000990B0895ACEF8127FBD066DDD2DD0C94C0 -:106FF000BB37E6EF846368617200F2D040DD98DA57 -:107000000C94A13EF4EFC128D3DF290038DD606481 -:107010000C94CE3106F085696865726568D009CF39 -:1070200016F0D65B636861725D00E7DF0C941D3E6D -:107030008363662C0C94983122F082637200B8DF6F -:107040000D0069D8B5DF0A000C948B303AF08663E6 -:10705000726561746500C4D02FDDB3DF9ADD0BDC8F -:10706000B6DF2ADA0F414C52454144592044454687 -:10707000494E454489DFA5DF20DCCAD999DF1000DD -:107080003BDB79DFCBDF36D932D049DDBCD0D1DE76 -:10709000D8DA37DDC3DF95DFB6D041DD29DDBEDFCD -:1070A0000CDC86DF8000CADEFADA24D970D180DFFA -:1070B000C0E147D915D9F5D8EAD89CDB09F4F9DA4B -:1070C0000C943E3F4EF0D8706F7374706F6E650015 -:1070D00087D0F2DC5EDD75DF4EDF80DF8BDB19F001 -:1070E00087D8F0E1AECA0C9498318369647068D88F -:1070F000DB018728646F65733E2945DA84D099DE09 -:1071000013DDF5DF96DECCDEF2DF09DD880F991F97 -:1071100018D939DAECDF0C944C3EC6F0D5646F65B3 -:10712000733E66D8FAF064D8D0E108951CF1C15BD3 -:107130005092E60108952EF1815D6092E601089576 -:1071400038F1813A88DFF9DF0C94B43142F1873AA3 -:107150006E6F6E616D6562DF0C949D384EF1D13BB0 -:10716000E7DF61FD24C05ADF29D08C01107F105D5C -:1071700059F08991999122D08E509449B9F48CE0BC -:1071800094E9DDD90C944C3E76DB9F7093FD906FB3 -:107190009BDA44DF13DA0CDFFEFFF9D009DF0C9431 -:1071A00008D0905888949795879503C0F7D800DF4A -:1071B00008950C943E3F5EF1822D40000CD001DF1B -:1071C0000C94863EB8F1D35B275D0EDF0C941D3E18 -:1071D000C6F1A2322D0002970895D2F182626C00AE -:1071E0000E94E0302000DCF18573746174659A932D -:1071F0008A938091E6019091E6010895E8F1866C0A -:107200006174657374000E94E030E101FEF18273E5 -:1072100030000FDCE4FF0EF2827230000ADCE6FF81 -:1072200083696E690E94E030D90118F28574696340 -:107230006B739A938A930FB7F8948E2D9F2D0FBF7F -:1072400008952CF2826D7300F4DFB8D9F6D5B9DE5B -:10725000F0DFC1D9C3DECEDAC9F30C94983244F220 -:10726000832E69644EDC8F7084D903C04ADC0AD057 -:10727000EBDE5BD1D8F71F910F910C94983260F23E -:10728000833E70729927803012F080320AF48EE2C9 -:10729000089537DC8DDE0F00D9D951D959DA4FD98D -:1072A00030DC5FD956D997D9FAD924DEFBDA61D917 -:1072B00009C07BD80BD27FDA42D90E94802F11F00F -:1072C000989403C032D1A8F718941F910F910AC067 -:1072D0006CD8DFDF19F075DEC5DF77D87CDFA9DD7C -:1072E0008FDAB1F70C94CE3180F285776F726473C8 -:1072F00077DFE2DB66DE5CDEE6F602D084DF99DD76 -:107300009EDE0C946839EAF2822E73005ED859DE54 -:107310000E9403317EDF8DDD5EDF47D801DA6ADA55 -:1073200019F04CDF1ADBF9CF03D90C94CE3108F3F6 -:107330008464756D70003CDE100080DA1AD920C0BC -:107340007EDE3FDE35DE040012DB32DE3A007CDE1C -:107350002FDE0F000ED9D5DB2BDE020008DBE5D0D7 -:10736000D0F71F910F9124DE100035D921DE0F00D8 -:1073700000D9C7DB87DF68DED8D0D8F71F910F911F -:10738000D4D0F0F61F910F910C9498328120AFDE8B -:107390000C94703330F383783E72FC01899199919B -:1073A00009D03196829392935292CF01089596F329 -:1073B000833E786190588894979587950895B0F3A7 -:1073C0008378613E880F991F90580895C0F38370A9 -:1073D000666C0E94E0300080CEF3837A666C0E9477 -:1073E000E0300000842C3F303D0065FD03C0E0DD4F -:1073F000F4E703C004D0DCDD00E86F7D6DC0D8DDAC -:10740000FCFFC5CF67D99F70906CD3CED1DD08F05B -:10741000D0CECEDD09F464FD9B7FCBCEDAF3D2690A -:10742000660064FDECDFE1DFF4DF6F7EF7DD62DD37 -:107430000C94023A1EF4D4656C736500EFDD5ADDDE -:10744000E1DF52DC0C94283A36F4D47468656E009F -:107450006260E4DD7ED8BFD8BEDE3CD9A9DD00C0C5 -:10746000FDD842DC0C944C3E4AF4D5626567696EE7 -:107470000C940E386AF4D5756E74696C626064FDA4 -:10748000BEDFB3DFC6DF6F7E0C944A3A76F4D56177 -:107490006761696E6260C2DD9ED89DDE0C94023A1F -:1074A0008EF4D57768696C65BCDF0C949F32A2F4CA -:1074B000D672657065617400EDDF0C94283AB0F403 -:1074C000D6696E6C696E65006F7E6F7D8DDD0C9484 -:1074D0006C3AC0F483696E2C1CDB73DD69DD0895A2 -:1074E00015D988D911F0CAD4F7CF0C94CE31D4F481 -:1074F000D3666F720E94F83072E590DDFBDC82DFAC -:107500008DDD0C949F32F0F4D46E65787400A0DFAA -:107510000E94F8302AF57ADFBDDF4ADD3CF50C9495 -:107520006C3A87286E6578742920FF91EF91BF919E -:10753000AF911197AF93BF93099408951F910F9145 -:10754000089508F595656E646974FF91EF911F9138 -:107550000F915F925F92099444F5D57264726F70D7 -:1075600027DD3CF50C946C3A5AF583733E6497FF23 -:10757000C1CCC9CC6AF587646E656761746549D012 -:107580000E9408320C94E63276F5883F646E656797 -:107590006174650023DD2ED909F0F1DF08958AF5C5 -:1075A0008464616273000DDD0C94CA3AA0F58264B4 -:1075B0002B00A991B991E991F99109911991A00F25 -:1075C000B11F8E1F9F1FBA93AA930895AEF58264D0 -:1075D0002D00D5DF0C94D93ACEF58364322F099172 -:1075E000199195958795179507951A930A9308957C -:1075F000DAF58364322A09911991000F111F881F4F -:10760000991F1A930A930895F2F58764696E766557 -:1076100072740991199100951095809590951A931F -:107620000A9308950AF68364303DA991B991892B94 -:107630008A2B8B2B51F48FEF9FEF089526F68364EE -:10764000303CA991B9919030B2F3882799270895D9 -:107650003EF682643D00BDDF0C94153B52F6826419 -:107660003C00B7DF0C94213B5EF682643E000E9432 -:10767000DC310C94313B6AF68375642E37D94FD9CF -:1076800057D90E944F320C94E53178F682642E006F -:107690002DD98F939F9387DF42D90E94C33253D94C -:1076A00047D90E944F320C94E5318CF6826869000C -:1076B0007FDCC0F60E9447310E94DE320C94863E89 -:1076C000FFDEFF0CFF08ACF6A24070009A938A938D -:1076D000CA010895C8F6837063409A938A93CA01D9 -:1076E0000C94A13ED6F6A370322B470D551D08957C -:1076F0000000866D61726B6572000E942C31ABDCFC -:1077000057DC00090E945131CDDBE0D9CBDB0E9470 -:1077100091320E943A31F1DC0E94E83083DDC2DB15 -:107720000C94663598DF856C6F61642B70610895E9 -:1077300026F7856C6F61642D7F7E25982D980895BE -:1077400000FE03C035DC50007FDC01FE03C030DCEE -:1077500045007ADC02FE03C02BDC420075DC03FE30 -:1077600003C026DC570070DC16FE03C021DC4D0090 -:107770006BDC0C94E53174FF02C0259A2D9876FFDE -:1077800007C003E0201621F401E003BF889553BE33 -:0677900074FD2D9A08951E -:067800000C94703D3BD02A -:0278080039D075 -:02780C0037D073 -:0278100035D071 -:0278140033D06F -:0278180031D06D -:02781C002FD06B -:027820002DD069 -:027824002BD067 -:0278280029D065 -:02782C0027D063 -:0278300025D061 -:0278340023D05F -:0278380033C05B -:02783C001FD05B -:027840001DD059 -:027844001BD057 -:0278480019D055 -:02784C0017D053 -:0278500015D051 -:0278540013D04F -:0278580011D04D -:02785C000FD04B -:027860000DD049 -:107864000BD09F918F911F910F91FF91EF91A9914F -:10787400B991BFBFB9911895BA93BFB7BA93AA93F8 -:10788400BF91AF91EF93FF930F931F938F939F93A8 -:10789400BFE7AB0FB1E0ED91FD910994BA93BFB787 -:1078A400BA93AA93E60CF51CE2CFE7EBF1E0A091C2 -:1078B400B401EA0FF51DB091C600BF3009F49ECFA4 -:1078C400B083A395AF71A093B401A091B601A39521 -:1078D400A093B601AE3109F404D0A4300AF021D04B -:1078E400C0CFFCE720C032F783747830813161F077 -:1078F400833191F0A0D20091C00005FFFBCF8093AB -:10790400C6008991999108958991999102C070FF57 -:1079140008957E7FF1E107C08991999102C070FDBD -:1079240008957160F3E1E091C000E5FFFCCFF093AE -:10793400C6000895ECF8837278307DD21ED00E9480 -:10794400FA33D9F39A938A93E7EBF1E0A091B50166 -:10795400EA0FF51D808199270FB7F894A395AF71AD -:10796400A093B501A091B601AA95A093B6010FBF4B -:1079740008953AF9847278303F00A091B601A511B8 -:107984000C948337C4DF0C947A37BEDC0E945C32DB -:107994000341443F0E944F32E2CA90588093E3016E -:1079A4009093E4019F3588F70091E30100780A1170 -:1079B40005C00091E4010B1101C0089575D0009138 -:1079C400E3010078A02EB090E40100E8F501A0E006 -:1079D400B1E015911D930A95E1F70895E7DA1300D4 -:1079E4000E948B30E3DA0A002DDCF894F50113E0F1 -:1079F4002DD011E12BD000E8A0E0B1E00F921F924E -:107A04000D901D9011E022D032960250C9F7E05833 -:107A1400F04015E01BD014D000E8A058B040059009 -:107A24001D9001105BC00150D1F71F900F900FEF14 -:107A3400B02E6E7F7894BADA11000E948B300895CC -:107A440087B686FE089511E101D0FACF87B680FC8F -:107A5400FDCF17BFE895089534FE8377642BF8941F -:107A6400A8959091600098619093600087708860F9 -:107A74008093600078940C9498325EFA8377642D36 -:107A8400F894A89554BE08E10093600050926000F9 -:107A94007894089580FAA3637764A89508959AFA70 -:107AA4008669666C7573680060FD98CF089578F9EF -:107AB40085656D7074797ADA40FF78DA000976DAD0 -:107AC4000C000E9466350C9456375524E1E0F2E030 -:107AD4003F010895B4FA847761726D00F894AA277F -:107AE400BB27C9E1D0E0DD93C150E9F71FB604B666 -:107AF40050923400ACE15D92B031E9F7BA94C1EA36 -:107B0400D2E004E412E00DBF1EBFDFDF0E94423D5D -:107B140003E012E018014ADA22DF48DAE50146DA26 -:107B24001C000E94663542DA0009EED0EAD90E94B0 -:107B34008B330E94FA3309F0BEDF65BE75BE74BC98 -:107B440003E005BD09EF07BD70926E002FDA573CC4 -:107B54002DDAA4019FD007E60093C40008E900933E -:107B6400C10006E00093C20071609ED97894E6DDFE -:107B740023D05AD10E94FA33D1F00E945C320345DB -:107B840053430E944F3212DAD0075CDB0E949830D4 -:107B94000E94FA3349F00E94913008DA1B000E94D7 -:107BA4008B330E94FA3319F43FD10E94A0300C9415 -:107BB400B137DAFA837665720E945C3223466C61CF -:107BC4007368466F72746820352041546D6567612F -:107BD4003332382032322E30332E323031370D0AE0 -:107BE4000C944F32B8FBA265690078940895EAFBBF -:107BF400A2646900F8940895F4FBC23B6900D6D9E5 -:107C04000C943AD1D3D9333C37D10C949838FEFB39 -:107C140084696E742100FC013197EE0FF0E8EF0FD8 -:107C2400F1E089919991C4DB0C94513E14FCC76C2A -:107C340069746572616CBAD9C2EF4CDC8093D70168 -:107C44009093D80160680E94E137982F92959F70B5 -:107C54008F70906E806810D1892F92959F708F706D -:107C6400906E80690C943E3F98DE89919991A0E0D2 -:107C7400B1E00091E3010F77A00F8D939D9374C041 -:107C840032FC823E6100282F392F89919991089501 -:107C940086FC8121993040F4FC018991999191836A -:107CA400808389919991089509D09038E8F60E94CB -:107CB400D5316BD001960981088367C062FF0895AE -:107CC40023DB0E945C320341443F0E944F326FCF5A -:107CD400FC01F058FB110BC00E2F00780A1539F483 -:107CE400A0E0B1E0EF77AE0F8D919D91089585915D -:107CF4009591089596FC82613E009A938A93822F0F -:107D0400932F0895FAFC8140993020F4FC0181916D -:107D1400919108959038E0F6F999FECF995081BD7C -:107D240092BDF89A00B5839581BDF89A90B5802FDD -:107D34000895CEDF992708950AFD826340009930A3 -:107D440020F4FC01819199270895903890F7E4DF9D -:107D54009927089522DE89919991A0E0B1E00091DC -:107D6400E3010F77A00F8D93616009C03EFD82632C -:107D74002100993038F4FC0189919991808389918B -:107D8400999108959BDF903828F7F999FECF99507F -:107D940081BD92BD8991999180BDFA9AF99AEFCFEC -:107DA40072FD83666C2D64600895A6FD83666C2B5A -:107DB4006B7F0895B0FD8576616C75654AD90E9424 -:107DC400563199D90E94E8300C94863EBAFD8564F8 -:107DD400656665723ED90E94D83762EF0E945631BB -:107DE4008AD90E94E8300C94AB30D2FDC26973008A -:107DF4000E94F4370E9459330E94593385DFF5D924 -:107E04000E94FA3329F017DF0E94F83098FC01C071 -:107E140041DF0895F0FDC2746F000C94FA3E1AFE1F -:107E2400877475726E6B65790E94E43ED90124FEF5 -:107E34008570617573659DDC1FB7F894A895DF9311 -:107E4400CF939F938F935F934F93F1010EB7029358 -:107E54000DB70293B291A2911D010E910EBF0E9126 -:107E64000DBF4F915F918F919F91CF91DF911FBF74 -:107E7400089570DF82692C000E940E380BDF0E9487 -:107E840067310C94C73978FE8369632C0E940E38DD -:107E940070DF0E9408320C94C73981200E940D358E -:107EA40033DF803111F484E209C08A3011F483E2B3 -:107EB40005C0823011F485E201C08FE3089552E2D7 -:107EC40060E270E20F921F9209911991809FD00194 -:107ED400EE27FF27909FB00DE11DF51D819FB00D8A -:107EE400E11DF51D919FE00DF11DBA93AA93CF01F9 -:107EF4001F900F900895E894882329F4992319F486 -:107F040068940C94703DDC011990E99189919991E0 -:107F140000E1FF27880F991F111CEE1FFF1F1A167F -:107F2400EB07F50518F083951A1AEB0B0A9589F7F8 -:107F3400EA931A920895B0E9BEE9CEE90000008000 -:087F44000C09FF02F2F67AEECF -:00000001FF diff --git a/forth/fib.fs b/forth/fib.fs new file mode 100644 index 0000000..8f4cfbc --- /dev/null +++ b/forth/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/firmware/config.inc b/forth/firmware/config.inc new file mode 100644 index 0000000..9c6cb9e --- /dev/null +++ b/forth/firmware/config.inc @@ -0,0 +1,117 @@ +;;; FlashForth device configuration for Atmega devices + +; Select the include file for your micro controller +;.include "m2561def.inc" ; +;.include "m2560def.inc" ; Tested Fuses: E:0xff H:0xdc L:0xff +;.include "m128def.inc" ; Tested Fuses: E:0xff H:0xdc L:0xff +;.include "m168pdef.inc" +;.include "m328pdef.inc" ; Tested Fuses: E:0xff H:0xda L:0xff +.include "m328def.inc" ; Tested Fuses: E:0xff H:0xda L:0xff +;.include "m32adef.inc" +;.include "m644pdef.inc" + +; Oscillator frequency in herz +.equ FREQ_OSC = 16000000 + +; Define the UART used for the operator +.equ OPERATOR_UART = 0 ; 0 or 1 + +;;; UART0 configuration +;;; Note: With Arduino Uno R3 and MEGA R3 the USB to serial bridge latency and queues +;;; disturb the XON/XOFF flow control. +;;; The workaround is to use XON/XOFF flow control and 1 ms intercharacter delay in the terminal program. Or use the ff-shell.py which adds CR LF flow control. +.equ BAUDRATE0 = 38400 ; Serial baudrate UART0 +.equ U0FC_TYPE = 1 ; 1 = XON/XOFF, 2=CTS/RTS +.equ U0RTS_PORT = portd +.equ U0RTS_DDR = ddrd +.equ U0RTS_BIT = 3 + +;;; UART1 configuration +.equ BAUDRATE1= 38400 ; Serial baudrate UART1 +.equ U1FC_TYPE = 1 ; 1 = XON/XOFF, 2=CTS/RTS +.equ U1RTS_PORT = portd +.equ U1RTS_DDR = ddrd +.equ U1RTS_BIT = 4 + +; Default number base +.equ BASE_DEFAULT = 10 ; 16 = hexadecimal, 10 = decimal + +; Set to 1 for power save when CPU is idle +.equ IDLE_MODE = 1 + +; Enable the cpu load measurement. Uses Timer 1. Needs IDLE_MODE = 1 +.equ CPU_LOAD = 0 + +; CPU load indicator led definitions. Needs IDLE_MODE = 1 +.equ CPU_LOAD_LED = 1 ; set to 1 to enable +.equ CPU_LOAD_DDR = ddrb +.equ CPU_LOAD_PORT = portb ; avr-p28:portc arduinomega:portb arduinouno:portb +.equ CPU_LOAD_BIT = 5 ; avr-p28:pin5 arduinomega:pin7 ardinouno:pin5 +.equ CPU_LOAD_LED_POLARITY = 1 ; avr-p28: 0 = low on port turns on led, + ; arduino : 1 = high on port turns on led + +; Define the startup delay for the turnkey words. Milliseconds +.equ TURNKEY_DELAY = 2000 ; milliseconds + +; UART buffer sizes +.equ RX0_BUF_SIZE = 32 ; 8,16,32,64 +.equ RX0_OFF_FILL = 4 ; Fill level for XOFF + +.equ RX1_BUF_SIZE = 32 ; 8,16,32,64 +.equ RX1_OFF_FILL = 4 ; Fill level for XOFF + +;;; USER AREA sizes for the OPERATOR task +.equ RETURN_STACK_SIZE = 64 ; 48 cells return stack +.equ PARAMETER_STACK_SIZE = 96 ; 32 cells parameter stack +.equ TIB_SIZE = 90 ; 80 chars tib size + 10 chars hold area + +; Set to 1 to allow control-o to reset FlashForth from the operator UART +.equ CTRL_O_WARM_RESET = 1 + +; Select which timer to use for the system millisecond ticks 0, 1, 2 +.equ MS_TIMER = 0 + +; Debug flash and eeprom writes +; Prints F=Write to FLASH E=Write to EEPROM +.equ DEBUG_FLASH = 0 + +#if defined(__ATmega2560__) +#define partstring "ATmega2560" +#elif defined(__ATmega328P__) +#define partstring "ATmega328P" +#elif defined(__ATmega328__) +#define partstring "ATmega328" +#elif defined(__ATmega128__) +#define partstring "ATmega128" +#elif defined(__ATmega2561__) +#define partstring "ATmega2561" +#elif defined(__ATmega644__) +#define partstring "ATmega644" +#else +#define partstring "ATmega" +#endif + +.if MS_TIMER == 0 +.ifdef OC0Aaddr +.equ MS_TIMER_ADDR = OC0Aaddr +.else +.equ MS_TIMER_ADDR = OC0addr +.endif +.endif + +.if MS_TIMER == 1 +.ifdef OC1Aaddr +.equ MS_TIMER_ADDR = OC1Aaddr +.else +.equ MS_TIMER_ADDR = OC1addr +.endif +.endif + +.if MS_TIMER == 2 +.ifdef OC2Aaddr +.equ MS_TIMER_ADDR = OC2Aaddr +.else +.equ MS_TIMER_ADDR = OC2addr +.endif +.endif + diff --git a/forth/firmware/ff-atmega.asm b/forth/firmware/ff-atmega.asm new file mode 100644 index 0000000..555e5c2 --- /dev/null +++ b/forth/firmware/ff-atmega.asm @@ -0,0 +1,6092 @@ +;********************************************************************** +; * +; Filename: FlashForth.asm * +; Date: 22.03.2017 * +; File Version: 5.0 * +; MCU: Atmega * +; Copyright: Mikael Nordman * +; Author: Mikael Nordman * +; * +;********************************************************************** +; FlashForth is a standalone Forth system for microcontrollers that +; can flash their own flash memory. +; +; Copyright (C) 2017 Mikael Nordman + +; This program is free software: you can redistribute it and/or modify +; it under the terms of the GNU General Public License version 3 as +; published by the Free Software Foundation. +; +; This program is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. +; +; You should have received a copy of the GNU General Public License +; along with this program. If not, see . +; +; Modified versions of FlashForth must be clearly marked as such, +; in the name of this file, and in the identification +; displayed when FlashForth starts. +;********************************************************************** + +; Include the FlashForth configuration file +.include "config.inc" + +; Define the FF version date string +#define DATE "22.03.2017" + + +; Register definitions + .def upl = r2 ; not in interrupt + .def uph = r3 ; not in interrupt + .def r_zero = r5 ; read only zero + .def r_one = r6 ; read only one + .def r_two = r7 ; read only two + .def t8 = r8 ; Not in interrupt + .def wflags = r9 ; not in interrupt + + .def loadreg0 = r4 ; + .def loadreg1 = r12 + .def loadreg2 = r13 + + + .def ibasel=r10 ; Not in interrupt + .def ibaseh=r11 ; Not in interrupt + .def ms_count = r14 ; Not in interrupt + .def ms_count1 = r15 ; Not in interrupt + .def t0 = r16 + .def t1 = r17 + .def t2 = r0 ; Not in interrupt + .def t3 = r1 ; Not in interrupt + + .def al = r18 + .def ah = r19 + .def pl = r20 ; P Register and FOR..LOOP INDEX variable + .def ph = r21 + + .def FLAGS1 = r22 ; Not in interrupt + .def FLAGS2 = r23 ; Not in interrupt + .def tosl = r24 + .def tosh = r25 +; xl = r26 +; xh = r27 +; yl = r28 ; StackPointer Ylo +; yh = r29 ; StackPointer Yhi +; zl = r30 +; zh = r31 + .def t4 = r26 + .def t5 = r27 + .def t6 = r30 + .def t7 = r31 + +; Macros +.macro poptos + ld tosl, Y+ + ld tosh, Y+ +.endmacro + +.macro pushtos + st -Y, tosh + st -Y, tosl +.endmacro + +.macro in_ +.if (@1 < $40) + in @0,@1 +.else + lds @0,@1 +.endif +.endmacro + +.macro out_ +.if (@0 < $40) + out @0,@1 +.else + sts @0,@1 +.endif +.endmacro + +.macro sbi_ +.if (@0 < $40) + sbi @0,@1 +.else + in_ @2,@0 + ori @2,exp2(@1) + out_ @0,@2 +.endif +.endmacro + +.macro cbi_ +.if (@0 < $40) + cbi @0,@1 +.else + in_ @2,@0 + andi @2,~(exp2(@1)) + out_ @0,@2 +.endif +.endmacro + +.macro lpm_ +.if (FLASHEND < 0x8000) ; Word address + lpm @0,@1 +.else + elpm @0,@1 +.endif +.endmacro + +.macro sub_pflash_z +.if (PFLASH > 0) + subi zh, high(PFLASH) +.endif +.endmacro + +.macro add_pflash_z +.if (PFLASH > 0) + subi zh, high(0x10000-PFLASH) +.endif +.endmacro + +.macro sub_pflash_tos +.if (PFLASH > 0) + subi tosh, high(PFLASH) +.endif +.endmacro + +.macro add_pflash_tos +.if (PFLASH > 0) + subi tosh, high(0x10000-PFLASH) +.endif +.endmacro + +.macro rampv_to_c +.if (FLASHEND >= 0x8000) + bset 0 +.else + bclr 0 +.endif +.endmacro + +.macro fdw + .dw ((@0<<1)+PFLASH) +.endmacro + +.macro m_pop_zh +.ifdef EIND + pop zh +.endif +.endmacro +.macro m_pop_xh +.ifdef EIND + pop xh + .endif +.endmacro +.macro m_pop_t0 +.ifdef EIND + pop t0 + .endif +.endmacro +.macro m_push_t0 +.ifdef EIND + push t0 + .endif +.endmacro +.macro mijmp +.ifdef EIND + eijmp +.else + ijmp +.endif +.endmacro + +; Symbol naming compatilibity +; UART0 symbols for Atmega32 +.ifndef UCSR0A +.equ UCSR0A=UCSRA +.equ UDR0_=UDR +.equ UCSR0B=UCSRB +.equ UCSR0C=UCSRC +.equ RXEN0=RXEN +.equ TXEN0=TXEN +.equ RXCIE0=RXCIE +.equ UCSZ00=UCSZ0 +.equ USBS0=USBS +.equ UBRR0H=UBRRH +.equ UBRR0L=UBRRL +.equ URSEL_=0x80 +.else +.equ UDR0_=UDR0 +.equ URSEL_=0 +.endif + +.ifndef SPMCSR +.equ SPMCSR=SPMCR +.endif + +.ifndef SPMEN +.equ SPMEN=SELFPRGEN +.endif + +.ifndef EEWE +.equ EEWE=EEPE +.endif + +.ifndef EEMWE +.equ EEMWE=EEMPE +.endif + +.if OPERATOR_UART == 1 +.equ OP_TX_=TX1_ +.equ OP_RX_=RX1_ +.equ OP_RXQ=RX1Q +.else +.if OPERATOR_UART == 0 +.equ OP_TX_=TX0_ +.equ OP_RX_=RX0_ +.equ OP_RXQ=RX0Q +.endif +.endif + +#define ubrr0val (FREQ_OSC/16/BAUDRATE0) - 1 +#define ubrr1val (FREQ_OSC/16/BAUDRATE1) - 1 + +.if FREQ_OSC < 16384000 ; Hz +.equ ms_value_tmr0 = ((FREQ_OSC/1000/64) - 1) +.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1) +.equ ms_value_tmr2 = ((FREQ_OSC/1000/64) - 1) +.ifdef TCCR0B +.equ ms_pre_tmr0 = 3 +.endif +.ifdef TCCR0 +.equ ms_pre_tmr0 = 4 +.endif +.ifdef TCCR2B +.equ ms_pre_tmr2 = 4 +.endif +.ifdef TCCR2 +.equ ms_pre_tmr2 = 3 +.endif + +.else ; FREQ_OSC >= 16384000 Hz + +.equ ms_value_tmr0 = ((FREQ_OSC/1000/256) - 1) +.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1) +.equ ms_value_tmr2 = ((FREQ_OSC/1000/128) - 1) +.ifdef TCCR0B +.equ ms_pre_tmr0 = 4 +.endif +.ifdef TCCR0 +.equ ms_pre_tmr0 = 6 +.endif +.ifdef TCCR2B +.equ ms_pre_tmr2 = 5 +.endif +.ifdef TCCR2 +.equ ms_pre_tmr2 = 4 +.endif +.endif +.equ CPU_LOAD_VAL = (FREQ_OSC*255/100000) +;.............................................................................. +;Program Specific Constants (literals used in code) +;.............................................................................. +; Flash page size +.equ PAGESIZEB=PAGESIZE*2 ; Page size in bytes + +; Forth word header flags +.equ NFA= 0x80 ; Name field mask +.equ IMMED= 0x40 ; Immediate mask +.equ INLINE= 0x20 ; Inline mask for 1 and 2 cell code +.equ INLINE4= 0x00 ; Inline mask for 4 cell code +.equ INLINE5= 0x00 ; Inline mask for 5 cell code +.equ COMPILE= 0x10 ; Compile only mask +.equ NFAmask= 0xf ; Name field length mask + +; FLAGS2 +.equ fIDLE= 6 ; 0 = busy, 1 = idle +.equ fLOAD= 5 ; Load measurement ready +.equ fLOADled= 4 ; 0 = no load led, 1 = load led on +.equ fFC_tx1= 3 ; 0=Flow Control, 1 = no Flow Control +.equ fFC_tx0= 2 ; 0=Flow Control, 1 = no Flow Control +.equ ixoff_tx1= 1 +.equ ixoff_tx0= 0 + +; FLAGS1 +.equ fLIT= 7 ; Literal compiled +.equ noclear= 6 ; dont clear optimisation flags +.equ idup= 5 ; Use dupzeroequal instead of zeroequal +.equ izeroeq= 4 ; Use brne instead of breq if zeroequal +.equ istream= 3 +.equ fLOCK= 2 +.equ fTAILC= 1 +.equ idirty= 0 + +;;; For Flow Control +.equ XON= 0x11 +.equ XOFF= 0x13 + +.equ CR_=0x0d +.equ LF_=0x0a +.equ BS_=0x08 +.equ TAB_=0x09 + +;;; Memory mapping prefixes +.equ PRAM = 0x0000 ; 8 Kbytes of ram (atm2560) +.equ PEEPROM = RAMEND+1 ; 4 Kbytes of eeprom (atm2560) +.if (FLASHEND == 0x1ffff) ; 128 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 52 Kbytes available for FlashForth(atm2560) +.equ PFLASH = 0 +.equ RAMPZV = 3 +.equ KERNEL_SIZE=0x0d80 +.else +.if (FLASHEND == 0xffff) ; 64 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth(atm128) +.equ PFLASH = 0 +.equ RAMPZV = 1 +.equ KERNEL_SIZE=0x0d00 +.else +.if (FLASHEND == 0x7fff) ; 32 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth +.equ PFLASH = 0 +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0d00 +.else +.if (FLASHEND == 0x3fff) ; 16 Kwords flash +.equ OFLASH = 0x8000 ; 32 Kbytes available for FlashForth +.equ PFLASH = OFLASH +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0c80 +.else +.if (FLASHEND == 0x1fff) ; 8 Kwords flash +.equ OFLASH = 0xC000 ; 16 Kbytes available for FlashForth +.equ PFLASH = OFLASH +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0c80 +.endif +.endif +.endif +.endif +.endif +.equ BOOT_SIZE=0x400 +.equ BOOT_START=FLASHEND - BOOT_SIZE + 1 ; atm128: 0xfc00, atm328: 0x3c00 +.equ KERNEL_START=BOOT_START - KERNEL_SIZE + +;;; High values for memory areas +.equ FLASH_HI = 0xffff - (BOOT_SIZE*2) - (KERNEL_SIZE*2) +.equ EEPROM_HI =PEEPROM + EEPROMEND +.equ RAM_HI = RAMEND + +;;; USER AREA for the OPERATOR task +.equ ursize= RETURN_STACK_SIZE +.equ ussize= PARAMETER_STACK_SIZE +.equ utibsize= TIB_SIZE + +;;; User variables and area +.equ us0= -28 ; Start of parameter stack +.equ ur0= -26 ; Start of ret stack +.equ uemit= -24 ; User EMIT vector +.equ ukey= -22 ; User KEY vector +.equ ukeyq= -20 ; User KEY? vector +.equ ubase= -18 ; Number Base +.equ utib= -16 ; TIB address +.equ utask= -14 ; Task area pointer +.equ ustatus= -12 +.equ uflg= -11 +.equ usource= -10 ; Two cells +.equ utoin= -6 ; Input stream +.equ ulink= -4 ; Task link +.equ ursave= -2 ; Saved ret stack pointer +.equ uhp= 0 ; Hold pointer + + +;;; Variables in EEPROM +.equ eeprom= PEEPROM +.equ dp_start= eeprom + 0x0000 ; TURNKEY +.equ dp_flash= eeprom + 0x0002 ; FLASH dictionary pointer +.equ dp_eeprom= eeprom + 0x0004 ; EEPROM dictionary pointer +.equ dp_ram= eeprom + 0x0006 ; RAM dictionary pointer +.equ latest= eeprom + 0x0008 ; Pointer to latest dictionary word +.equ prompt= eeprom + 0x000a ; Deferred prompt +.equ ehere= eeprom + 0x000c + +;**************************************************** +.dseg +ibuf: .byte PAGESIZEB +ivec: .byte INT_VECTORS_SIZE + +rxqueue0: +rbuf0_wr: .byte 1 +rbuf0_rd: .byte 1 +rbuf0_lv: .byte 1 +rbuf0: .byte RX0_BUF_SIZE + +.ifdef UCSR1A +rxqueue1: +rbuf1_wr: .byte 1 +rbuf1_rd: .byte 1 +rbuf1_lv: .byte 1 +rbuf1: .byte RX1_BUF_SIZE +.endif + +litbuf0: .byte 1 +litbuf1: .byte 1 + +dpSTART: .byte 2 +dpFLASH: .byte 2 ; DP's and LATEST in RAM +dpEEPROM: .byte 2 +dpRAM: .byte 2 +dpLATEST: .byte 2 + +iaddrl: .byte 1 +iaddrh: .byte 1 +.ifdef RAMPZ +iaddru: .byte 1 +ibaseu: .byte 1 +.endif + +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 +load_acc: .byte 3 ; Load measurement accumulator +load_res: .byte 3 ; Load result +.endif +.endif + +cse: .byte 1 ; Current data section 0=flash, 1=eeprom, 2=ram +state: .byte 1 ; Compilation state +uvars: .byte (-us0) +up0: .byte 2 +urbuf: .byte ursize +usbuf: .byte ussize +utibbuf: .byte utibsize +dpdata: .byte 2 + +.eseg +.org 0 + .dw 0xffff ; Force first cell of eeprom to 0xffff +;******************************************************************* +; Start of kernel +;******************************************************************* +.cseg +.if (FLASHEND == 0x1ffff) +.org 0x17e80 +.else +.org KERNEL_START +.endif +;*********************************************************** +CMP: + call TOR + rjmp CMP2 +CMP1: + call NEQUALSFETCH + call MINUS + call ZEROSENSE + breq CMP2 + jmp TWODROPZ +CMP2: + call XNEXT + brcc CMP1 + jmp TWODROPNZ + +.if (FLASHEND == 0x1ffff) +.org KERNEL_START+0x0 +.endif +;;; ************************************************* +;;; WARM user area data +.equ warmlitsize= 28 +WARMLIT: + .dw 0x0200 ; cse, state + .dw utibbuf-4 ; S0 + .dw usbuf-1 ; R0 + fdw OP_TX_ + fdw OP_RX_ + fdw OP_RXQ + .dw BASE_DEFAULT ; BASE + .dw utibbuf ; TIB + fdw OPERATOR_AREA ; TASK + .dw 0 ; ustatus & uflg + .dw 0 ; source + .dw 0 ; source + .dw 0 ; TOIN + .dw up0 ; Task link +; M? -- caddr count current data space string +; dw L_DOTBASE +L_MEMQ: + .db NFA|1," " +MEMQ: + call CSE_ + call DOLIT + fdw MEMQADDR_N + call PLUS + call FETCH_A + call CFETCHPP + call DOLIT + .dw NFAmask + jmp AND_ + +.if (FLASHEND == 0x1ffff) + fdw PAUSE_L +WDON_L: + .db NFA|3,"wd+" +WDON: + cli + wdr + lds tosh, WDTCSR + ori tosh, (1<r c@ swap or r> c! +; ; + fdw ICCOMMA_L +MSET_L: + .db NFA|4,"mset",0 +MSET: + movw zl, tosl + poptos + ld t0, z + or t0, tosl + st z, t0 + poptos + ret + +; : mclr ( mask addr -- ) +; dup >r c@ swap invert and r> c! +; ; + fdw MSET_L +MCLR_L: + .db NFA|4,"mclr",0 +MCLR_: + movw zl, tosl + poptos + ld t0, z + com tosl + and t0, tosl + st z, t0 + poptos + ret + +; LSHIFT x1 u -- x2 + fdw MCLR_L +LSHIFT_L: + .db NFA|6,"lshift",0 +LSHIFT: + movw zl, tosl + poptos +LSHIFT1: + sbiw zl, 1 + brmi LSHIFT2 + lsl tosl + rol tosh + rjmp LSHIFT1 +LSHIFT2: + ret + +; RSHIFT x1 u -- x2 + fdw LSHIFT_L +RSHIFT_L: + .db NFA|6,"rshift",0 +RSHIFT: + movw zl, tosl + poptos +RSHIFT1: + sbiw zl, 1 + brmi RSHIFT2 + lsr tosh + ror tosl + rjmp RSHIFT1 +RSHIFT2: + ret + +;********************************************** +NEQUALSFETCH: + rcall CFETCHPP + rcall ROT + rcall CFETCHPP + rjmp ROT +;*************************************************** +; N= c-addr nfa -- n string:name cmp +; n=0: s1==s2, n=ffff: s1!=s2 +; N= is specificly used for finding dictionary entries +; It can also be used for comparing strings shorter than 16 characters, +; but the first string must be in ram and the second in program memory. + fdw RSHIFT_L +NEQUAL_L: + .db NFA|2,"n=",0 +NEQUAL: + rcall NEQUALSFETCH + andi tosl, 0xf + rcall EQUAL + rcall ZEROSENSE + breq NEQUAL5 + rcall ONEMINUS + rcall CFETCHPP + rcall TOR + rjmp NEQUAL4 +NEQUAL2: + rcall NEQUALSFETCH + rcall NOTEQUAL + rcall ZEROSENSE + breq NEQUAL3 + rcall TRUE_ + call LEAVE + rjmp NEQUAL4 +NEQUAL3: + rcall RFETCH + rcall ZEROSENSE + brne NEQUAL4 + rcall FALSE_ +NEQUAL4: + call XNEXT + brcc NEQUAL2 + pop t1 + pop t0 + rjmp NEQUAL6 +NEQUAL5: + rcall TRUE_ +NEQUAL6: + rcall NIP + jmp NIP + +; SKIP c-addr u c -- c-addr' u' +; skip matching chars +; u (count) must be smaller than 256 + fdw NEQUAL_L +SKIP_L: + .db NFA|4,"skip",0 +SKIP: + + rcall TOR +SKIP0: + rcall DUPZEROSENSE + breq SKIP2 + + rcall OVER + rcall CFETCH_A + + rcall DUP + rcall DOLIT + .dw TAB_ + rcall EQUAL + rcall ZEROSENSE + brne SKIP05 + rcall RFETCH + rcall EQUAL + rcall ZEROSENSE + breq SKIP2 + rjmp SKIP1 +SKIP05: + rcall DROP +SKIP1: + rcall ONE + rcall SLASHSTRING + rjmp SKIP0 +SKIP2: + pop t0 + pop t0 + ret + + +; SCAN c-addr u c -- c-addr' u' +; find matching chars + + + fdw SKIP_L +SCAN_L: + .db NFA|4,"scan",0 +SCAN: + rcall STORE_P_TO_R + rcall TOR + rjmp SCAN3 +SCAN1: + rcall CFETCHPP + rcall DUP + rcall DOLIT + .dw TAB_ + rcall EQUAL + rcall ZEROSENSE + breq SCAN2 + rcall DROP + rjmp SCAN25 +SCAN2: + call FETCH_P + rcall EQUAL + rcall ZEROSENSE + breq SCAN3 +SCAN25: + rcall ONEMINUS + rjmp SCAN4 +SCAN3: + call XNEXT + brcc SCAN1 +SCAN4: + rcall RFROM + rcall ONEPLUS + rcall R_TO_P + ret + +; : mtst ( mask addr -- flag ) +; c@ and +; ; + fdw SCAN_L +MTST_L: + .db NFA|4,"mtst",0 +MTST: + movw zl, tosl + ld tosl, z+ + ld t0, Y+ + ld t1, Y+ + and tosl, t0 + clr tosh + ret + + + fdw MTST_L +FCY_L: + .db NFA|3,"Fcy" + rcall DOCREATE + .dw FREQ_OSC / 1000 + +;;; Check parameter stack pointer + .db NFA|3,"sp?" +check_sp: + rcall SPFETCH + call R0_ + rcall FETCH_A + call S0 + rcall FETCH_A + rcall ONEPLUS + rcall WITHIN + rcall XSQUOTE + .db 3,"SP?" + rcall QABORT + ret +;*************************************************** +; EMIT c -- output character to the emit vector + fdw FCY_L +EMIT_L: + .db NFA|4,"emit",0 +EMIT: + rcall UEMIT_ + jmp FEXECUTE + +;*************************************************** +; KEY -- c get char from UKEY vector + fdw EMIT_L +KEY_L: + .db NFA|3,"key" +KEY: + rcall UKEY_ + jmp FEXECUTE + +;*************************************************** +; KEY -- c get char from UKEY vector + fdw KEY_L +KEYQ_L: + .db NFA|4,"key?",0 +KEYQ: + rcall UKEYQ_ + jmp FEXECUTE + + fdw KEYQ_L +EXECUTE_L: + .db NFA|7,"execute" +EXECUTE: + movw zl, tosl + sub_pflash_z + poptos + rampv_to_c + ror zh + ror zl + mijmp + + fdw EXECUTE_L +FEXECUTE_L: + .db NFA|3,"@ex" +FEXECUTE: + rcall FETCH_A + jmp EXECUTE + + fdw FEXECUTE_L +VARIABLE_L: + .db NFA|8,"variable",0 +VARIABLE_: + rcall HERE + rcall CELL + rcall ALLOT + jmp CONSTANT_ + + fdw VARIABLE_L +TWOVARIABLE_L: + .db NFA|9,"2variable" +TWOVARIABLE_: + rcall HERE + rcall DOLIT + .dw 0x4 + rcall ALLOT + jmp CONSTANT_ + + fdw TWOVARIABLE_L +CONSTANT_L: + .db NFA|8,"constant",0 +CONSTANT_: + rcall COLON + call LITERAL + jmp SEMICOLON + + fdw CONSTANT_L +TWOCONSTANT_L: + .db NFA|9,"2constant" +TWOCONSTANT_: + rcall SWOP + rcall COLON + call LITERAL + call LITERAL + jmp SEMICOLON + +; DOCREATE, code action of CREATE +; Fetch the next cell from program memory to the parameter stack +DOCREATE_L: + .db NFA|3, "(c)" +DOCREATE: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + m_pop_zh + pop zh + pop zl + mijmp + +;;; Resolve the runtime action of the word created by using does> +DODOES_L: + .db NFA|3, "(d)" +DODOES: + m_pop_xh + pop xh + pop xl + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + movw z, x + mijmp ; (z) + +FETCHLIT: + pushtos + lsl zl + rol zh + lpm_ tosl, z+ + lpm_ tosh, z+ + ret + + .db NFA|3, "(,)" +DOCOMMAXT: + m_pop_t0 + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + push zl + push zh + m_push_t0 + rjmp COMMAXT + +; SP@ -- addr get parameter stack pointer + fdw TWOCONSTANT_L +SPFETCH_L: + .db NFA|3,"sp@" +SPFETCH: + movw z, y + pushtos + movw tosl, z + ret + +; SP! addr -- store stack pointer + .db NFA|3,"sp!" +SPSTORE: + movw y, tosl + ret + +; RPEMPTY -- EMPTY THE RETURN STACK + .db NFA|3,"rp0" +RPEMPTY: + m_pop_xh + pop xh + pop xl + call R0_ + rcall FETCH_A + out spl, tosl + out sph, tosh + poptos + movw zl, xl + mijmp + +; RP@ Fetch the return stack pointer + fdw SPFETCH_L +RPFETCH_L: + .db NFA|INLINE|COMPILE|3,"rp@" +RPFETCH: + pushtos + in tosl, spl + in tosh, sph + ret + +; >< Swap bytes + fdw RPFETCH_L +SWAPB_L: + .db NFA|INLINE|2,"><",0 +SWAPB: + mov t0, tosl + mov tosl, tosh + mov tosh, t0 + ret + +; DICTIONARY POINTER FOR the current section +; Flash -- sets the data section to flash + fdw SWAPB_L +FLASH_L: +ROM_N: + .db NFA|5,"flash" +ROM_: + sts cse, r_zero + ret + +; EEPROM -- sets the data section to EEPROM data memory + fdw FLASH_L +EEPROM_L: +EROM_N: + .db NFA|6,"eeprom",0 +EROM: + sts cse, r_two + ret + +; RAM -- sets the data section to RAM memory + fdw EEPROM_L +RAM_L: +FRAM_N: + .db NFA|3,"ram" +FRAM: + ldi t0, 4 + sts cse, t0 + ret + +; DP -- a-addr +; Fetched from EEPROM + fdw RAM_L +DP_L: + .db NFA|2,"dp",0 +DP: + rcall IDP + rcall CSE_ + jmp PLUS + + +;;; + .db NFA|3,"cse" +CSE_: + pushtos + lds tosl, cse + clr tosh + ret + +; HERE -- addr get current data space ptr +; DP @ ; + fdw DP_L +HERE_L: + .db NFA|4,"here",0 +HERE: + rcall DP + jmp FETCH + +; , x -- append cell to current data space +; HERE ! CELL ALLOT ; + fdw HERE_L +COMMA_L: + .db NFA|1,"," +COMMA: + rcall HERE + rcall STORE_A + rcall CELL + jmp ALLOT + +; C, c -- append char to current data space +; HERE C! 1 ALLOT ; + fdw COMMA_L +CCOMMA_L: + .db NFA|2,"c,",0 +CCOMMA: + rcall HERE + rcall CSTORE_A + rcall ONE + jmp ALLOT + + +; CELL -- n size of one cell + fdw CCOMMA_L +CELL_L: + .db NFA|4,"cell",0 +CELL: + pushtos + ldi tosl, 2 + ldi tosh, 0 + ret + +; ALIGN -- align DP + fdw CELL_L +ALIGN_L: + .db NFA|5,"align" +ALIGN: + rcall HERE + rcall ALIGNED + rcall DP + jmp STORE + +; ALIGNED addr -- a-addr align given addr + fdw ALIGN_L +ALIGNED_L: + .db NFA|7,"aligned" +ALIGNED: + adiw tosl, 1 + cbr tosl, 1 + ret + +; CELL+ a-addr1 -- a-addr2 add cell size +; 2 + ; + fdw ALIGNED_L +CELLPLUS_L: + .db NFA|INLINE|5,"cell+" +CELLPLUS: + adiw tosl, 2 + ret + +; CELLS n1 -- n2 cells->adrs units + fdw CELLPLUS_L +CELLS_L: + .db NFA|INLINE|5,"cells" +CELLS: + lsl tosl + rol tosh + ret + +; CHAR+ c-addr1 -- c-addr2 add char size + fdw CELLS_L +CHARPLUS_L: + .db NFA|INLINE|5,"char+" +CHARPLUS: + adiw tosl, 1 + ret + +; CHARS n1 -- n2 chars->adrs units + fdw CHARPLUS_L +CHARS_L: + .db NFA|INLINE|5,"chars" +CHARS: ret + + fdw CHARS_L +COMMAXT_L: + .db NFA|3, "cf," +COMMAXT: + rcall DUP + rcall IHERE + rcall MINUS + rcall ABS_ + rcall DOLIT + .dw 0xff0 + rcall GREATER + rcall ZEROSENSE + breq STORECF1 +STORECFF1: +; rcall CALL_ + rcall DOLIT +.ifdef EIND + .dw 0x940F ; On Atmega 2560 all code is on 128 - 256 Kword area. +.else + .dw 0x940E ; call jmp:0x940d +.endif + call ICOMMA + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + rjmp STORECF2 +STORECF1: + rcall IHERE + rcall MINUS + rcall TWOMINUS + rcall TWOSLASH + ;rcall RCALL_ + andi tosh, 0x0f + ori tosh, 0xd0 +STORECF2: + jmp ICOMMA + + +; !COLON -- change code field to docolon +; -6 IALLOT ; +; .dw link +;link set $ + .db NFA|2,"!:",0 +STORCOLON: + rcall DOLIT + .dw 0xfffa ; -6 + jmp IALLOT + + +; 2@ a-addr -- x1 x2 fetch 2 cells +; DUP @ SWAP CELL+ @ ; +; the lower address will appear on top of stack + fdw COMMAXT_L +TWOFETCH_L: + .db NFA|2,"2@",0 +TWOFETCH: + rcall DUP + rcall FETCH_A + rcall SWOP + rcall CELLPLUS + jmp FETCH_A + +; 2! x1 x2 a-addr -- store 2 cells +; SWAP OVER ! CELL+ ! ; +; the top of stack is stored at the lower adrs + fdw TWOFETCH_L +TWOSTORE_L: + .db NFA|2,"2!",0 +TWOSTORE: + rcall SWOP + rcall OVER + rcall CELLPLUS + rcall STORE_A + jmp STORE + +; 2DROP x1 x2 -- drop 2 cells +; DROP DROP ; + fdw TWOSTORE_L +TWODROP_L: + .db NFA|5,"2drop" +TWODROP: + rcall DROP + jmp DROP + +; 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells +; OVER OVER ; + fdw TWODROP_L +TWODUP_L: + .db NFA|4,"2dup",0 +TWODUP: + rcall OVER + jmp OVER + +; 2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 dup top 2 cells + fdw TWODUP_L +TWOSWAP_L: + .db NFA|5,"2swap" +TWOSWAP: + rcall ROT + rcall TOR + rcall ROT + rcall RFROM + ret + +; INPUT/OUTPUT ================================== + +; SPACE -- output a space +; BL EMIT ; + fdw TWOSWAP_L +SPACE_L: + .db NFA|5,"space" +SPACE_: + rcall BL + jmp EMIT + +; SPACES n -- output n spaces +; BEGIN DUP WHILE SPACE 1- REPEAT DROP ; + fdw SPACE_L +SPACES_L: + .db NFA|6,"spaces",0 +SPACES: +SPCS1: + rcall DUPZEROSENSE + breq SPCS2 + rcall SPACE_ + rcall ONEMINUS + rjmp SPCS1 +SPCS2: jmp DROP + + +; umin u1 u2 -- u unsigned minimum +; 2DUP U> IF SWAP THEN DROP ; + fdw SPACES_L +UMIN_L: + .db NFA|4,"umin",0 +UMIN: + rcall TWODUP + rcall UGREATER + rjmp MINMAX + +; umax u1 u2 -- u unsigned maximum +; 2DUP U< IF SWAP THEN DROP ; + fdw UMIN_L +UMAX_L: + .db NFA|4,"umax",0 +UMAX: + rcall TWODUP + rcall ULESS +MINMAX: + rcall ZEROSENSE + breq UMAX1 + rcall SWOP +UMAX1: jmp DROP + + fdw UMAX_L +ONE_L: + .db NFA|INLINE4|1,"1" +ONE: + pushtos + ldi tosl, 1 + ldi tosh, 0 + ret + +; ACCEPT c-addr +n -- +n' get line from terminal + fdw ONE_L +ACCEPT_L: + .db NFA|6,"accept",0 +ACCEPT: + rcall OVER + rcall PLUS + rcall OVER +ACC1: + rcall KEY + + cpi tosl, CR_ + brne ACC_LF + + rcall TRUE_ + rcall FCR + rcall CSTORE_A + rcall DROP + rjmp ACC6 +ACC_LF: + cpi tosl, LF_ + brne ACC2 + rcall DROP + + rcall FCR + rcall CFETCH_A + rcall ZEROSENSE + breq ACC6 + rcall FALSE_ + rcall FCR + rcall CSTORE_A + rjmp ACC1 +ACC2: + rcall FALSE_ + rcall FCR + rcall CSTORE_A + rcall DUP + rcall EMIT + rcall DUP + rcall DOLIT + .dw BS_ + rcall EQUAL + rcall ZEROSENSE + breq ACC3 + rcall DROP + rcall ONEMINUS + rcall TOR + rcall OVER + rcall RFROM + rcall UMAX + rjmp ACC1 +ACC3: + rcall OVER + rcall CSTORE_A + rcall ONEPLUS + rcall OVER + rcall UMIN + rcall TWODUP + rcall NOTEQUAL + rcall ZEROSENSE + brne ACC1 +ACC6: + rcall NIP + rcall SWOP + jmp MINUS + + .db NFA|3,"fcr" +FCR: + rcall DOUSER + .dw uflg + + +; TYPE c-addr u -- type line to terminal u < $100 +; : type for c@+ emit next drop ; + + fdw ACCEPT_L +TYPE_L: + .db NFA|4,"type",0 +TYPE: + rcall TOR + rjmp TYPE2 ; XFOR +TYPE1: + rcall CFETCHPP + rcall EMIT +TYPE2: + call XNEXT + brcc TYPE1 + pop t1 + pop t0 + jmp DROP + + +; (S" -- c-addr u run-time code for S" + .db NFA|3,"(s",0x22 +XSQUOTE: + m_pop_zh + pop zh + pop zl + lsl zl + rol zh + lpm_ t0, z+ + pushtos + movw tosl, zl + add_pflash_tos + pushtos + mov tosl, t0 + clr tosh + add zl, t0 + adc zh, tosh + adiw zl, 1 + rampv_to_c + ror zh + ror zl + mijmp + + fdw TYPE_L +SQUOTE_L: + .db NFA|IMMED|COMPILE|2,"s",0x22,0 +SQUOTE: + rcall DOCOMMAXT + fdw XSQUOTE + rcall ROM_ + rcall CQUOTE + jmp FRAM + + fdw SQUOTE_L +CQUOTE_L: + .db NFA|2,",",0x22,0 +CQUOTE: + rcall DOLIT + .dw 0x22 + rcall PARSE + rcall HERE + rcall OVER + rcall ONEPLUS + rcall ALIGNED + rcall ALLOT + jmp PLACE + + + fdw CQUOTE_L +DOTQUOTE_L: + .db NFA|IMMED|COMPILE|2,".",0x22,0 +DOTQUOTE: + rcall SQUOTE + rcall DOCOMMAXT + fdw TYPE + ret + + fdw DOTQUOTE_L +ALLOT_L: + .db NFA|5,"allot" +ALLOT: + rcall DP + jmp PLUSSTORE + + fdw ALLOT_L +DROP_L: + .db NFA|INLINE|4,"drop",0 +DROP: + poptos + ret + + fdw DROP_L +SWOP_L: + .db NFA|INLINE5|4,"swap",0 +SWOP: + ld t0, y+ + ld t1, y+ + pushtos + movw tosl, t0 + ret + + fdw SWOP_L +OVER_L: + .db NFA|INLINE4|4,"over",0 +OVER: + pushtos + ldd tosl, y+2 + ldd tosh, y+3 + ret + + fdw OVER_L +ROT_L: + .db NFA|3, "rot" +ROT: + rcall TOR + rcall SWOP + rcall RFROM + jmp SWOP + + fdw ROT_L +TOR_L: + .db NFA|COMPILE|2,">r",0 +TOR: + m_pop_zh + pop zh + pop zl + push tosl + push tosh + poptos + mijmp + + fdw TOR_L +RFROM_L: + .db NFA|COMPILE|2,"r>",0 +RFROM: + m_pop_zh + pop zh + pop zl + pushtos + pop tosh + pop tosl + mijmp + + fdw RFROM_L +RFETCH_L: + .db NFA|COMPILE|2,"r@",0 +RFETCH: + m_pop_zh + pop zh + pop zl + pushtos + pop tosh + pop tosl + push tosl + push tosh + mijmp + +; ABS n --- n1 absolute value of n + fdw DUP_L +ABS_L: + .db NFA|3,"abs" +ABS_: + rcall DUP + jmp QNEGATE + + fdw ABS_L +PLUS_L: + .db NFA|INLINE4|1, "+" + +PLUS: + ld t0, Y+ + ld t1, Y+ + add tosl, t0 + adc tosh, t1 + ret + +; m+ ( d n -- d1 ) + fdw PLUS_L +MPLUS_L: + .db NFA|2, "m+",0 +MPLUS: + rcall STOD + jmp DPLUS + + fdw MPLUS_L +MINUS_L: + .db NFA|INLINE5|1, "-" +MINUS: + ld t0, Y+ + ld t1, Y+ + sub t0, tosl + sbc t1, tosh + movw tosl, t0 + ret + +FROM_LITBUF: + lds r0, litbuf0 + lds r1, litbuf1 + ret +PLUSC_: + rcall FROM_LITBUF + com r0 + com r1 + add r0, r_one + adc r1, r_zero + rcall ANDIC1 + rjmp MINUSC_1 +MINUSC_: + rcall ANDIC0 +MINUSC_1: + ori tosh, 0x50 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x40 + rjmp ICOMMA_ +ANDIC0: + rcall FROM_LITBUF +ANDIC1: + rcall IDPMINUS + rcall IDPMINUS + mov tosl, r0 +ANDIC2: + mov tosh, tosl + swap tosh + andi tosl, 0x0f + andi tosh, 0x0f + ori tosl, 0x80 + ret +ANDIC_: + rcall ANDIC0 + ori tosh, 0x70 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x70 + rjmp ICOMMA_ +ORIC_: + rcall ANDIC0 + ori tosh, 0x60 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x60 +ICOMMA_: + jmp ICOMMA + + fdw MINUS_L +AND_L: + .db NFA|INLINE4|3, "and" +AND_: + ld t0, Y+ + ld t1, Y+ + and tosl, t0 + and tosh, t1 + ret + + fdw AND_L +OR_L: + .db NFA|INLINE4|2, "or",0 +OR_: + ld t0, Y+ + ld t1, Y+ + or tosl, t0 + or tosh, t1 + ret + + fdw OR_L +XOR_L: + .db NFA|INLINE4|3, "xor" +XOR_: + ld t0, Y+ + ld t1, Y+ + eor tosl, t0 + eor tosh, t1 + ret + + fdw XOR_L +INVERT_L: + .db NFA|INLINE|6, "invert",0 +INVERT: + com tosl + com tosh + ret + + fdw INVERT_L +NEGATE_L: + .db NFA|6, "negate",0 +NEGATE: + com tosl + com tosh + adiw tosl, 1 + ret + + fdw NEGATE_L +ONEPLUS_L: + .db NFA|INLINE|2, "1+",0 +ONEPLUS: + adiw tosl, 1 + ret + + fdw ONEPLUS_L +ONEMINUS_L: + .db NFA|INLINE|2, "1-",0 +ONEMINUS: + sbiw tosl, 1 + ret + + fdw ONEMINUS_L +TWOPLUS_L: + .db NFA|INLINE|2, "2+",0 +TWOPLUS: + adiw tosl, 2 + ret + + fdw TWOPLUS_L +TOBODY_L: + .db NFA|INLINE|5, ">body" +TOBODY: + adiw tosl, 4 + ret + + fdw TOBODY_L +TWOSTAR_L: + .db NFA|INLINE|2, "2*",0 +TWOSTAR: + lsl tosl + rol tosh + ret + + fdw TWOSTAR_L +TWOSLASH_L: + .db NFA|INLINE|2, "2/",0 +TWOSLASH: + asr tosh + ror tosl + ret + + fdw TWOSLASH_L +PLUSSTORE_L: + .db NFA|2,"+!",0 +PLUSSTORE: + rcall SWOP + rcall OVER + rcall FETCH_A + rcall PLUS + rcall SWOP + jmp STORE + + fdw PLUSSTORE_L +WITHIN_L: + .db NFA|6,"within",0 +WITHIN: + rcall OVER + rcall MINUS + rcall TOR + rcall MINUS + rcall RFROM + jmp ULESS + + fdw WITHIN_L +NOTEQUAL_L: + .db NFA|2,"<>",0 +NOTEQUAL: + rcall EQUAL + jmp ZEROEQUAL + + fdw ZEROLESS_L +EQUAL_L: + .db NFA|1, "=" +EQUAL: + rcall MINUS + jmp ZEROEQUAL + + + fdw EQUAL_L +LESS_L: + .db NFA|1,"<" +LESS: + rcall MINUS + jmp ZEROLESS + + fdw LESS_L +GREATER_L: + .db NFA|1,">" +GREATER: + rcall SWOP + jmp LESS + + fdw GREATER_L +ULESS_L: + .db NFA|2,"u<",0 +ULESS: + rcall MINUS ; Carry is valid after MINUS + sbc tosl, tosl + sbc tosh, tosh + ret + + fdw ULESS_L +UGREATER_L: + .db NFA|2, "u>",0 +UGREATER: + rcall SWOP + jmp ULESS + + fdw UGREATER_L +STORE_P_L: + .db NFA|2,"!p",0 +STORE_P: + movw pl, tosl + poptos + ret + + fdw STORE_P_L +STORE_P_TO_R_L: + .db NFA|COMPILE|4,"!p>r",0 +STORE_P_TO_R: + m_pop_zh + pop zh + pop zl + push pl + push ph + movw pl, tosl + poptos + mijmp + + fdw STORE_P_TO_R_L +R_TO_P_L: + .db NFA|COMPILE|3,"r>p" +R_TO_P: + m_pop_zh + pop zh + pop zl + pop ph + pop pl + mijmp + + fdw R_TO_P_L +PFETCH_L: + .db NFA|2,"p@",0 +PFETCH: + pushtos + movw tosl, pl + jmp FETCH + + fdw PFETCH_L +PSTORE_L: + .db NFA|2,"p!",0 +PSTORE: + pushtos + movw tosl, pl + jmp STORE + + fdw PSTORE_L +PCSTORE_L: + .db NFA|3,"pc!" +PCSTORE: + pushtos + movw tosl, pl + jmp CSTORE + + fdw PCSTORE_L +PPLUS_L: + .db NFA|INLINE|2,"p+",0 +PPLUS: + add pl, r_one + adc ph, r_zero + ret + + fdw PPLUS_L +PNPLUS_L: + .db NFA|3,"p++" +PNPLUS: + add pl, tosl + adc ph, tosh + poptos + ret + + fdw PNPLUS_L +UEMIT_L: + .db NFA|5,"'emit" +UEMIT_: + rcall DOUSER + .dw uemit + + fdw UEMIT_L +UKEY_L: + .db NFA|4,"'key",0 +UKEY_: + rcall DOUSER + .dw ukey + + fdw UKEY_L +UKEYQ_L: + .db NFA|5,"'key?" +UKEYQ_: + rcall DOUSER + .dw ukeyq + + .db NFA|3,"?0=" +ZEROSENSE: + sbiw tosl, 0 + poptos + ret + + .db NFA|3,"d0=" +DUPZEROSENSE: + sbiw tosl, 0 + ret + + fdw UKEYQ_L +UMSTAR_L: + .db NFA|3,"um*" +UMSTAR: + jmp umstar0 + + fdw UMSTAR_L +UMSLASHMOD_L: + .db NFA|6,"um/mod",0 +UMSLASHMOD: + jmp umslashmod0 + + + fdw UMSLASHMOD_L +USLASHMOD_L: + .db NFA|5,"u/mod" +USLASHMOD: + rcall FALSE_ + rcall SWOP + jmp umslashmod0 + + fdw USLASHMOD_L +STAR_L: + .db NFA|1,"*" +STAR: + rcall UMSTAR + jmp DROP + + fdw STAR_L +USLASH_L: + .db NFA|2,"u/",0 +USLASH: + rcall USLASHMOD + jmp NIP + + fdw USLASH_L +USSMOD_L: + .db NFA|6,"u*/mod",0 +USSMOD: + rcall TOR + rcall UMSTAR + rcall RFROM + jmp UMSLASHMOD + + + fdw USSMOD_L +SLASH_L: + .db NFA|1,"/" +SLASH: + rcall TWODUP + rcall XOR_ + rcall TOR + rcall ABS_ + rcall SWOP + rcall ABS_ + rcall SWOP + rcall USLASH + rcall RFROM + jmp QNEGATE + + fdw SLASH_L +NIP_L: + .db NFA|INLINE|3,"nip" +NIP: + ld t0, y+ + ld t0, y+ + ret + + fdw NIP_L +TUCK_L: + .db NFA|4,"tuck",0 +TUCK: + rcall SWOP + jmp OVER + + fdw TUCK_L +QNEGATE_L: + .db NFA|7,"?negate" +QNEGATE: + rcall ZEROLESS + rcall ZEROSENSE + breq QNEGATE1 + rcall NEGATE +QNEGATE1: + ret + + fdw QNEGATE_L +MAX_L: + .db NFA|3,"max" +MAX: rcall TWODUP + rcall LESS + rjmp MINMAX + + fdw MAX_L +MIN_L: + .db NFA|3,"min" +MIN: rcall TWODUP + rcall GREATER + rjmp MINMAX + + .db NFA|2,"c@",0 +CFETCH_A: + jmp CFETCH + + .db NFA|2,"c!",0 +CSTORE_A: + jmp CSTORE + + fdw MIN_L +UPTR_L: + .db NFA|2,"up",0 +UPTR: rcall DOCREATE + .dw 2 ; upl + + fdw UPTR_L +HOLD_L: + .db NFA|4,"hold",0 +HOLD: rcall TRUE_ + rcall HP + rcall PLUSSTORE + rcall HP + rcall FETCH_A + jmp CSTORE + +; <# -- begin numeric conversion +; PAD HP ! ; (initialize Hold Pointer) + fdw HOLD_L +LESSNUM_L: + .db NFA|2,"<#",0 +LESSNUM: + rcall PAD + rcall HP + jmp STORE + +; digit n -- c convert to 0..9a..z + fdw LESSNUM_L +TODIGIT_L: + .db NFA|5,"digit" +TODIGIT: + cpi tosl, 0xa + brlt TODIGIT1 + adiw tosl, 0x27 +TODIGIT1: + adiw tosl, 0x30 + ret + +; # ud1 -- ud2 convert 1 digit of output +; base @ ud/mod rot >digit hold ; + fdw TODIGIT_L +NUM_L: + .db NFA|1,"#" +NUM: + rcall BASE + rcall FETCH_A + rcall UDSLASHMOD + rcall ROT + rcall TODIGIT + jmp HOLD + +; #S ud1 -- ud2 convert remaining digits +; begin # 2dup or 0= until ; + fdw NUM_L +NUMS_L: + .db NFA|2,"#s",0 +NUMS: + rcall NUM + rcall TWODUP + rcall OR_ + rcall ZEROSENSE + brne NUMS + ret + +; #> ud1 -- c-addr u end conv., get string +; 2drop hp @ pad over - ; + fdw NUMS_L +NUMGREATER_L: + .db NFA|2,"#>", 0 +NUMGREATER: + rcall TWODROP + rcall HP + rcall FETCH_A + rcall PAD + rcall OVER + jmp MINUS + +; SIGN n -- add minus sign if n<0 +; 0< IF 2D HOLD THEN ; + fdw NUMGREATER_L +SIGN_L: + .db NFA|4,"sign",0 +SIGN: + cpi tosh, 0 + brpl SIGN1 + rcall DOLIT + .dw 0x2D + rcall HOLD +SIGN1: + jmp DROP + +; U. u -- display u unsigned +; <# 0 #S #> TYPE SPACE ; + fdw SIGN_L +UDOT_L: + .db NFA|2,"u.",0 +UDOT: + rcall LESSNUM + rcall FALSE_ + rcall NUMS + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + + +; U.R u +n -- display u unsigned in field of n. 1 type space ; + fdw UDOT_L +UDOTR_L: + .db NFA|3,"u.r" +UDOTR: + rcall LESSNUM + rcall ONEMINUS + rcall TOR + rcall FALSE_ + rjmp UDOTR2 +UDOTR1: + rcall NUM +UDOTR2: + rcall XNEXT + brcc UDOTR1 + pop t1 + pop t0 + rcall NUMS + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + +; . n -- display n signed +; <# DUP ABS #S SWAP SIGN #> TYPE SPACE ; + fdw UDOTR_L +DOT_L: + .db NFA|1,"." +DOT: rcall LESSNUM + rcall DUP + rcall ABS_ + rcall FALSE_ + rcall NUMS + rcall ROT + rcall SIGN + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + + FDW DOT_L +DECIMAL_L: + .db NFA|7,"decimal" +DECIMAL: + rcall TEN + rcall BASE + jmp STORE + +; HEX -- set number base to hex +; #16 BASE ! ; + Fdw DECIMAL_l +HEX_L: + .db NFA|3,"hex" +HEX: + rcall DOLIT + .dw 16 + rcall BASE + jmp STORE + +; BIN -- set number base to binary +; #2 BASE ! ; + Fdw HEX_L +BIN_L: + .db NFA|3,"bin" +BIN: rcall CELL + rcall BASE + jmp STORE + +; RSAVE -- a-addr Saved return stack pointer + fdw BIN_L +RSAVE_L: + .db NFA|5,"rsave" +RSAVE_: rcall DOUSER + .dw ursave + + +; ULINK -- a-addr link to next task + fdw RSAVE_L +ULINK_L: + .db NFA|5,"ulink" +ULINK_: rcall DOUSER + .dw ulink + + +; TASK -- a-addr TASK pointer + fdw ULINK_L +TASK_L: + .db NFA|4,"task",0 +TASK: rcall DOUSER + .dw utask + + +; HP -- a-addr HOLD pointer + fdw TASK_L +HP_L: + .db NFA|2,"hp",0 +HP: rcall DOUSER + .dw uhp + +; PAD -- a-addr User Pad buffer + fdw HP_L +PAD_L: + .db NFA|3,"pad" +PAD: + rcall TIB + rcall TIBSIZE + jmp PLUS + +; BASE -- a-addr holds conversion radix + fdw PAD_L +BASE_L: + .db NFA|4,"base",0 +BASE: + rcall DOUSER + .dw ubase + +; USER n -- + fdw BASE_L +USER_L: + .db NFA|4,"user",0 +USER: + rcall CREATE + rcall CELL + rcall NEGATE + rcall IALLOT + rcall ICOMMA_ + rcall XDOES +DOUSER: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + add tosl, upl + adc tosh, uph + ret + +; SOURCE -- adr n current input buffer +; 'SOURCE 2@ ; length is at higher adrs + fdw USER_L +SOURCE_L: + .db NFA|6,"source",0 +SOURCE: + rcall TICKSOURCE + jmp TWOFETCH + + +; /STRING a u n -- a+n u-n trim string +; swap over - >r + r> + fdw SOURCE_L +SLASHSTRING_L: + .db NFA|7,"/string" +SLASHSTRING: + rcall SWOP + rcall OVER + rcall MINUS + rcall TOR + rcall PLUS + rcall RFROM + ret + +; \ Skip the rest of the line + fdw SLASHSTRING_L +BSLASH_L: + .db NFA|IMMED|1,0x5c +BSLASH: + rcall SOURCE + rcall TOIN + rcall STORE_A + sbr FLAGS1, (1<C nfa -- cfa name adr -> code field + fdw FETCHPP_L +NTOC_L: + .db NFA|3,"n>c" +NFATOCFA: + rcall CFETCHPP + andi tosl, 0x0f + rcall PLUS + jmp ALIGNED + +; C>N cfa -- nfa code field addr -> name field addr + fdw NTOC_L +CTON_L: + .db NFA|3,"c>n" +CFATONFA: + rcall TWOMINUS + rcall DUP + rcall CFETCH_A + call TO_A + sbrs al, 7 + breq CFATONFA + ret + +; findi c-addr nfa -- c-addr 0 if not found +; xt 1 if immediate +; xt -1 if "normal" + fdw CTON_L +BRACFIND_L: + .db NFA|3,"(f)" +findi: +findi1: +FIND_1: + rcall TWODUP + rcall NEQUAL + rcall DUPZEROSENSE + breq findi2 + rcall DROP + rcall TWOMINUS ;;; NFATOLFA + rcall FETCH_A + rcall DUP +findi2: + rcall ZEROSENSE + brne findi1 + rcall DUPZEROSENSE + breq findi3 + rcall NIP + rcall DUP + rcall NFATOCFA + rcall SWOP + rcall IMMEDQ + rcall ZEROEQUAL + rcall ONE + rcall OR_ +findi3: + ret + +; IMMED? nfa -- f fetch immediate flag + fdw BRACFIND_L +IMMEDQ_L: + .db NFA|6,"immed?",0 +IMMEDQ: + rcall CFETCH_A + mov wflags, tosl ; COMPILE and INLINE flags for the compiler + andi tosl, IMMED + ret + +; FIND c-addr -- c-addr 0 if not found +; xt 1 if immediate +; xt -1 if "normal" + fdw IMMEDQ_L +FIND_L: + .db NFA|4,"find",0 +FIND: + rcall DOLIT + fdw kernellink + rcall findi + rcall DUPZEROSENSE + brne FIND1 + rcall DROP + rcall LATEST_ + rcall FETCH_A + rcall findi +FIND1: + ret + +; DIGIT? c -- n -1 if c is a valid digit + fdw FIND_L +DIGITQ_L: + .db NFA|6,"digit?",0 +DIGITQ: + ; 1 = 0x31 a = 0x61 + cpi tosl, 0x40 + brlt DIGITQ1 + sbiw tosl, 0x27 +DIGITQ1: + sbiw tosl, 0x30 ; 1 + brpl DIGITQ2 + rjmp FALSE_ +DIGITQ2: + rcall DUP ; 1 1 + rcall BASE ; 1 1 base + rcall FETCH_A ; 1 1 10 + jmp LESS ; 1 ffff + + +; SIGN? adr n -- adr' n' f get optional sign +; + leaves $0000 flag +; - leaves $0002 flag + fdw DIGITQ_L +SIGNQ_L: + .db NFA|5,"sign?" +SIGNQ: + rcall OVER + rcall CFETCH_A + mov t0, tosl + rcall DROP + cpi t0, '-' + breq SIGNQMINUS + cpi t0, '+' + breq SIGNQPLUS + rjmp SIGNQEND +SIGNQMINUS: + rcall SLASHONE + rjmp TRUE_ +SIGNQPLUS: + rcall SLASHONE +SIGNQEND: + jmp FALSE_ +SLASHONE: + rcall ONE + jmp SLASHSTRING + +; UD* ud u -- ud + fdw SIGNQ_L +UDSTAR_L: + .db NFA|3,"ud*" +UDSTAR: + push tosl + push tosh + rcall UMSTAR + rcall DROP + rcall SWOP + rcall RFROM + rcall UMSTAR + rcall ROT + jmp PLUS + +; UD/MOD ud u --u(rem) ud(quot) + fdw UDSTAR_L +UDSLASHMOD_L: + .db NFA|6,"ud/mod",0 +UDSLASHMOD: + rcall TOR ; ud.l ud.h + rcall FALSE_ ; ud.l ud.h 0 + rcall RFETCH ; ud.l ud.h 0 u + rcall UMSLASHMOD ; ud.l r.h q.h + rcall ROT ; r.h q.h ud.l + rcall ROT ; q.h ud.l r.h + rcall RFROM ; q.h ud.l r.h u + rcall UMSLASHMOD ; q.h r.l q.l + jmp ROT ; r.l q.l q.h + +; >NUMBER 0 0 adr u -- ud.l ud.h adr' u' +; convert string to number + fdw UDSLASHMOD_L +TONUMBER_L: + .db NFA|7,">number" +TONUMBER: + ldi al, 1 +TONUM1: + rcall DUPZEROSENSE ; ud.l ud.h adr u + breq TONUM3 + rcall TOR + push tosl ; dup >r + push tosh ; ud.l ud.h adr + rcall CFETCH_A + cpi tosl, '.' + breq TONUM_SKIP + rcall DIGITQ ; ud.l ud.h digit flag + rcall ZEROSENSE + brne TONUM2 + rcall DROP + rcall RFROM + rcall RFROM + rjmp TONUM3 +TONUM2: + rcall TOR ; ud.l ud.h digit + rcall BASE + rcall FETCH_A + rcall UDSTAR + rcall RFROM + rcall MPLUS + ldi al, 0 + rjmp TONUM_CONT +TONUM_SKIP: + rcall DROP +TONUM_CONT: + rcall RFROM + rcall RFROM + rcall SLASHONE + rjmp TONUM1 +TONUM3: + add tosl, al + ret + +; NUMBER? c-addr -- n 1 +; -- dl dh 2 +; -- c-addr 0 if convert error + fdw TONUMBER_L +NUMBERQ_L: + .db NFA|7,"number?" +NUMBERQ: + rcall DUP ; a a + rcall FALSE_ ; a a 0 0 + rcall FALSE_ ; a a 0 0 + rcall ROT ; a 0 0 a + rcall CFETCHPP ; a 0 0 a' u + rcall SIGNQ ; a 0 0 a' u f + rcall TOR ; a 0 0 a' u + + rcall BASE + rcall FETCH_A + rcall TOR ; a 0 0 a' u + + rcall OVER + rcall CFETCH_A + + sbiw tosl, '#' + cpi tosl, 3 + brsh BASEQ1 + + rcall CELLS + rcall DOLIT + fdw BASEQV + rcall PLUS + rcall FEXECUTE + + rcall SLASHONE + rjmp BASEQ2 +BASEQ1: + rcall DROP +BASEQ2: ; a 0 0 a' u + rcall TONUMBER ; a ud.l ud.h a' u + rcall RFROM ; a ud.l ud.h a' u oldbase + rcall BASE ; a ud.l ud.h a' u oldbase addr + rcall STORE_A ; a ud.l ud.h a' u + rcall ZEROSENSE ; a ud.l ud.h a' u + breq QNUMD +QNUM_ERR: ; Not a number + rcall RFROM ; a ud.l ud.h a' u sign + rcall TWODROP + rcall TWODROP + rcall FALSE_ ; a 0 Not a number + rjmp QNUM3 +QNUMD: ; Single or Double number + ; a ud.l ud.h a' + sbiw tosl, 1 + rcall CFETCH_A ; a ud.l ud.h c + call TO_A + rcall RFROM ; a a' u ud.l ud.d sign + rcall ZEROSENSE + breq QNUMD1 + rcall DNEGATE +QNUMD1: + cpi al, '.' ; a d.l d.h + brne QNUM1 + rcall ROT ; d.l d.h a + ldi tosl, 2 + ldi tosh, 0 ; d.l d.h 2 Double number + rjmp QNUM3 +QNUM1: ; single precision dumber + ; a d.l d.h + rcall DROP ; a n + rcall NIP ; n + rcall ONE ; n 1 Single number +QNUM3: + ret + + + .db NFA|4,"swap",0 +SWOP_A: + jmp SWOP + +; TI# -- n size of TIB +; : ti# task @ 8 + @ ; + fdw NUMBERQ_L +TIBSIZE_L: + .db NFA|3,"ti#" +TIBSIZE: + rcall TASK + rcall FETCH_A + adiw tosl, 8 + jmp FETCH + +; TIB -- a-addr Terminal Input Buffer + fdw TIBSIZE_L +TIB_L: + .db NFA|3,"tib" +TIB: + rcall TIU + jmp FETCH + +; TIU -- a-addr Terminal Input Buffer user variable + fdw TIB_L +TIU_L: + .db NFA|3,"tiu" +TIU: + rcall DOUSER + .dw utib ; pointer to Terminal input buffer + +; >IN -- a-addr holds offset into TIB +; In RAM + fdw TIU_L +TOIN_L: + .db NFA|3,">in" +TOIN: + rcall DOUSER + .dw utoin + +; 'SOURCE -- a-addr two cells: len, adrs +; In RAM ? + fdw TOIN_L +TICKSOURCE_L: + .db NFA|7,"'source" +TICKSOURCE: + rcall DOUSER + .dw usource ; two cells !!!!!! + +WORDQ: + rcall DUP + m_pop_t0 + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + rcall EQUAL + rcall ZEROSENSE + mijmp + +; INTERPRET c-addr u -- interpret given buffer + fdw TICKSOURCE_L +INTERPRET_L: + .db NFA|9,"interpret" +INTERPRET: + rcall TICKSOURCE + rcall TWOSTORE + rcall FALSE_ + rcall TOIN + rcall STORE_A +IPARSEWORD: + rcall INIT_012 + rcall BL + rcall WORD + + rcall DUP + rcall CFETCH_A + rcall ZEROSENSE + brne IPARSEWORD1 + rjmp INOWORD +IPARSEWORD1: + rcall FIND ; sets also wflags + rcall DUPZEROSENSE ; 0 = not found, -1 = normal, 1 = immediate + brne IPARSEWORD2 ; NUMBER? + rjmp INUMBER +IPARSEWORD2: + rcall ONEPLUS ; 0 = normal 2 = immediate + rcall STATE_ + rcall ZEROEQUAL + rcall OR_ + rcall ZEROSENSE + breq ICOMPILE_1 ; Compile a word + + ; Execute a word + ; immediate&compiling or interpreting + sbrs wflags, 4 ; Compile only check + rjmp IEXECUTE ; Not a compile only word + rcall STATE_ ; Compile only word check + rcall XSQUOTE + .db 12,"COMPILE ONLY",0 + rcall QABORT +IEXECUTE: + cbr FLAGS1, (1< type +;;; <# [char] > hold cse @ #s #> type base ! ; + fdw INLINED_L +DOTSTATUS_L: + .db NFA|3,".st" +DOTSTATUS: + rcall DOLIT + .dw '<' + rcall EMIT + call DOTBASE + rcall EMIT + rcall DOLIT + .dw ',' + rcall EMIT + call MEMQ + rcall TYPE + rcall DOLIT + .dw '>' + rcall EMIT + jmp DOTS + + .db NFA|2,">r",0 +TOR_A: jmp TOR + + +;;; TEN ( -- n ) Leave decimal 10 on the stack +; .db NFA|1,"a" +TEN: + rcall DOCREATE + .dw 10 + +; dp> ( -- ) Copy ini, dps and latest from eeprom to ram +; .dw link +; link set $ + .db NFA|3,"dp>" +DP_TO_RAM: + rcall DOLIT + .dw dp_start + rcall INI + rcall TEN + jmp CMOVE + +; >dp ( -- ) Copy only changed turnkey, dp's and latest from ram to eeprom +; .dw link +; link set $ + .db NFA|3,">dp" +DP_TO_EEPROM: + rcall DOLIT + .dw dp_start + rcall STORE_P_TO_R + rcall INI + rcall DOLIT + .dw 4 + rcall TOR +DP_TO_EEPROM_0: + rcall FETCHPP + rcall DUP + rcall PFETCH + rcall NOTEQUAL + rcall ZEROSENSE + breq DP_TO_EEPROM_1 +.if DEBUG_FLASH == 1 + rcall DOLIT + .dw 'E' + call EMIT +.endif + rcall PSTORE + rjmp DP_TO_EEPROM_2 +DP_TO_EEPROM_1: + rcall DROP +DP_TO_EEPROM_2: + rcall PTWOPLUS +DP_TO_EEPROM_3: + rcall XNEXT + brcc DP_TO_EEPROM_0 + pop t1 + pop t0 + rcall R_TO_P + jmp DROP + + fdw DOTSTATUS_L +FALSE_L: + .db NFA|5,"false" +FALSE_: ; TOS is 0000 (FALSE) + pushtos + clr tosl + clr tosh + ret + + fdw FALSE_L +TRUE_L: + .db NFA|4,"true",0 +TRUE_: ; TOS is ffff (TRUE) + pushtos + ser tosl + ser tosh + ret + +; QUIT -- R: i*x -- interpret from kbd + fdw TRUE_L +QUIT_L: + .db NFA|4,"quit",0 +QUIT: + rcall RPEMPTY + rcall LEFTBRACKET + rcall FRAM +QUIT0: + ;; Copy INI and DP's from eeprom to ram + rcall DP_TO_RAM +QUIT1: + rcall check_sp + rcall CR + rcall TIB + rcall DUP + rcall TIBSIZE + sbiw tosl, 10 ; Reserve 10 bytes for hold buffer + rcall ACCEPT + rcall SPACE_ + rcall INTERPRET + rcall STATE_ + rcall ZEROSENSE + brne QUIT1 + rcall IFLUSH + rcall DP_TO_EEPROM + + rcall XSQUOTE + .db 3," ok" + rcall TYPE + rcall PROMPT_ + jmp QUIT0 + + + fdw QUIT_L +PROMPT_L: + .db NFA|6,"prompt",0 +PROMPT_: + call DEFER_DOES + .dw prompt + +; ABORT i*x -- R: j*x -- clear stk & QUIT + fdw PROMPT_L +ABORT_L: + .db NFA|5,"abort" +ABORT: + rcall S0 + rcall FETCH_A + rcall SPSTORE + jmp QUIT ; QUIT never rets + +; ?ABORT f -- abort & print ? + fdw ABORT_L +QABORTQ_L: + .db NFA|7,"?abort?" +QABORTQ: + rcall XSQUOTE + .db 1,"?" + jmp QABORT + + +; ?ABORT f c-addr u -- abort & print msg if flag is false + fdw QABORTQ_L +QABORT_L: + .db NFA|6,"?abort",0 +QABORT: + rcall ROT + rcall ZEROSENSE + brne QABO1 +QABORT1: + rcall SPACE_ + rcall TYPE + rcall ABORT ; ABORT never returns +QABO1: jmp TWODROP + +; ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0 +; i*x x1 -- R: j*x -- x1<>0 + fdw QABORT_L +ABORTQUOTE_L: + .db NFA|IMMED|COMPILE|6,"abort",0x22,0 +ABORTQUOTE: + rcall SQUOTE + rcall DOCOMMAXT + fdw QABORT + ret + +;*************************************************** +; LIT -- x fetch inline 16 bit literal to the stack + fdw ABORTQUOTE_L +DOLIT_L: + .db NFA|3, "lit" +DOLIT: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + mijmp ; (z) + +; DUP must not be reachable from user code with rcall + fdw RFETCH_L +DUP_L: + .db NFA|INLINE|3, "dup" +DUP: + pushtos + ret + + fdw NOTEQUAL_L +ZEROEQUAL_L: + .db NFA|2, "0=",0 +ZEROEQUAL: + sbiw tosl, 1 + sbc tosl, tosl + sbc tosh, tosh + ret + + fdw ZEROEQUAL_L +ZEROLESS_L: + .db NFA|2, "0<",0 +ZEROLESS: + lsl tosh + sbc tosl, tosl + sbc tosh, tosh + ret + + +; ' -- xt find word in dictionary + fdw DOLIT_L +TICK_L: + .db NFA|1,0x27 ; 27h = ' +TICK: + rcall BL + rcall WORD + rcall FIND + jmp QABORTQ + +; CHAR -- char parse ASCII character + fdw TICK_L +CHAR_L: + .db NFA|4,"char",0 +CHAR: + rcall BL + rcall PARSE + rcall DROP + jmp CFETCH + +; ( -- skip input until ) + fdw CHAR_L +PAREN_L: + .db NFA|IMMED|1,"(" +PAREN: + rcall DOLIT + .dw ')' + rcall PARSE + sbr FLAGS1, (1< swap cells + ; +; ram table table_a flash table table_b eeprom table table_c +; ram variable qqq +; eeprom variable www ram +; flash variable rrr ram +; eeprom create calibrationtable 30 allot ram +; + fdw CR_L +CREATE_L: + .db NFA|6,"create",0 +CREATE: + rcall BL + rcall WORD ; Parse a word + + rcall DUP ; Remember parsed word at rhere + rcall FIND + rcall NIP + rcall ZEROEQUAL + rcall XSQUOTE + .db 15,"ALREADY DEFINED" + rcall QABORT ; ABORT if word has already been defined + rcall DUP ; Check the word length + rcall CFETCH_A + rcall ONE + rcall DOLIT + .dw 16 + rcall WITHIN + rcall QABORTQ ; Abort if there is no name for create + + rcall IHERE + rcall ALIGNED + rcall IDP ; Align the flash DP. + rcall STORE_A + + rcall LATEST_ + rcall FETCH_A + rcall ICOMMA_ ; Link field + rcall CFETCHPP ; str len + rcall IHERE + rcall DUP + rcall LATEST_ ; new 'latest' link + rcall STORE_A ; str len ihere + rcall PLACE ; + rcall IHERE ; ihere + rcall CFETCH_A + rcall DOLIT + .dw NFA + rcall SHB + rcall ONEPLUS + rcall ALIGNED + rcall IALLOT ; The header has now been created + rcall DOLIT + fdw DOCREATE ; compiles the runtime routine to fetch the next dictionary cell to the parameter stack + rcall STORECFF1 ; Append an exeution token, CALL ! + rcall ALIGN + rcall HERE ; compiles the current dataspace dp into the dictionary + rcall CSE_ + rcall ZEROSENSE + brne CREATE2 + rcall TWOPLUS +CREATE2: + jmp ICOMMA ; dp now points to a free cell + +;*************************************************************** +; POSTPONE + fdw CREATE_L +POSTPONE_L: + .db NFA|IMMED|COMPILE|8,"postpone",0 +POSTPONE: + rcall BL + rcall WORD + rcall FIND + rcall DUP + rcall QABORTQ + rcall ZEROLESS + rcall ZEROSENSE + breq POSTPONE1 + rcall DOCOMMAXT + fdw DOCOMMAXT + rjmp ICOMMA_ +POSTPONE1: + jmp COMMAXT + + +IDP_L: + .db NFA|3,"idp" +IDP: + rcall DOCREATE + .dw dpFLASH + +;*************************************************************** +; (DOES>) -- run-time action of DOES> +; .dw link +;link set $ + .db NFA|7,"(does>)" +XDOES: + m_pop_zh + rcall RFROM + rcall LATEST_ + rcall FETCH_A + rcall NFATOCFA + rcall IDP + rcall FETCH_A + rcall TOR_A + rcall IDP + rcall STORE_A + lsl tosl + rol tosh + rcall STORECFF1 ; Always stores a 4 byte call + rcall RFROM + rcall IDP + jmp STORE + + +; DOES> -- change action of latest def'n + fdw POSTPONE_L +DOES_L: + .db NFA|IMMED|COMPILE|5,"does>" +DOES: rcall DOCOMMAXT + fdw XDOES + rcall DOCOMMAXT + fdw DODOES + ret + + +;***************************************************************** +; [ -- enter interpretive state + fdw DOES_L +LEFTBRACKET_L: + .db NFA|IMMED|1,"[" +LEFTBRACKET: + sts state, r_zero + ret + + +; ] -- enter compiling state + fdw LEFTBRACKET_L +RIGHTBRACKET_L: + .db NFA|1,"]" +RIGHTBRACKET: + sts state, r_one + ret + +; : -- begin a colon definition + fdw RIGHTBRACKET_L +COLON_L: + .db NFA|1,":" +COLON: + rcall CREATE + rcall RIGHTBRACKET + jmp STORCOLON + +; :noname -- a define headerless forth code + fdw COLON_L +NONAME_L: + .db NFA|7,":noname" +NONAME: + rcall IHERE + jmp RIGHTBRACKET + +; ; -- end a colon definition + fdw NONAME_L +SEMICOLON_L: + .db NFA|IMMED|COMPILE|1,";" +SEMICOLON: + rcall LEFTBRACKET + sbrc FLAGS1, fTAILC + rjmp ADD_RETURN_1 + rcall IHERE + rcall MINUS_FETCH + movw t0, tosl + andi t1, 0xf0 + subi t1, 0xd0 + breq RCALL_TO_JMP + poptos + rcall MINUS_FETCH +.ifdef EIND + subi tosl, 0x0f +.else + subi tosl, 0x0e +.endif + sbci tosh, 0x94 + brne ADD_RETURN +CALL_TO_JMP: +.ifdef EIND + ldi tosl, 0x0d +.else + ldi tosl, 0x0c +.endif + ldi tosh, 0x94 + rcall SWOP + jmp STORE +RCALL_TO_JMP: + rcall NIP + andi tosh, 0x0f + sbrc tosh, 3 + ori tosh, 0xf0 + rcall TWOSTAR + rcall IHERE + rcall PLUS + rcall DOLIT + .dw -2 + rcall IALLOT + rcall DOLIT +.ifdef EIND + .dw 0x940d +.else + .dw 0x940c ; jmp:0x940c +.endif + rcall ICOMMA__ + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + rjmp ICOMMA__ +ADD_RETURN: + rcall TWODROP +ADD_RETURN_1: + rcall DOLIT ; Compile a ret + .dw 0x9508 +ICOMMA__: + jmp ICOMMA + + + + fdw SEMICOLON_L +MINUS_FETCH_L: + .db NFA|2,"-@",0 +MINUS_FETCH: + rcall TWOMINUS + rcall DUP + jmp FETCH + +; ['] -- find word & compile as DOLITeral + fdw MINUS_FETCH_L +BRACTICK_L: + .db NFA|IMMED|COMPILE|3,"[']" +BRACTICK: + rcall TICK ; get xt of 'xxx' + jmp LITERAL + +; 2- n -- n-2 + fdw BRACTICK_L +TWOMINUS_L: + .db NFA|INLINE|2,"2-",0 +TWOMINUS: + sbiw tosl, 2 + ret + + +; BL -- char an ASCII space + fdw TWOMINUS_L +BL_l: + .db NFA|2,"bl",0 +BL: + call DOCREATE + .dw ' ' + +; STATE -- flag holds compiler state + fdw BL_L +STATE_L: + .db NFA|5,"state" +STATE_: + pushtos + lds tosl, state + lds tosh, state + ret + +; LATEST -- a-addr + fdw STATE_L +LATEST_L: + .db NFA|6,"latest",0 +LATEST_: + call DOCREATE + .dw dpLATEST + +; S0 -- a-addr start of parameter stack + fdw LATEST_L +S0_L: + .db NFA|2,"s0",0 +S0: + rcall DOUSER + .dw us0 + +; R0 -- a-addr start of parameter stack + fdw S0_L +R0_L: + .db NFA|2,"r0",0 +R0_: + rcall DOUSER + .dw ur0 + +; ini -- a-addr ini variable contains the user-start xt +; In RAM +; .dw link +;link set $ + .db NFA|3,"ini" +INI: + call DOCREATE + .dw dpSTART + +; ticks -- u system ticks (0-ffff) in milliseconds + fdw R0_L +TICKS_L: + .db NFA|5,"ticks" +TICKS: + pushtos + in_ t0, SREG + cli + mov tosl, ms_count + mov tosh, ms_count1 + out_ SREG, t0 + ret + + +; ms +n -- Pause for n millisconds +; : ms ( +n -- ) +; ticks - +; begin +; pause dup ticks - 0< +; until drop ; +; + fdw TICKS_L +MS_L: + .db NFA|2,"ms",0 +MS: + rcall TICKS + rcall PLUS +MS1: + rcall PAUSE + rcall DUP + rcall TICKS + rcall MINUS + rcall ZEROLESS + rcall ZEROSENSE + breq MS1 + jmp DROP + +; .id ( nfa -- ) + fdw MS_L +DOTID_L: + .db NFA|3,".id" +DOTID: + rcall CFETCHPP + andi tosl, 0x0f + rcall TOR + rjmp DOTID3 +DOTID1: + rcall CFETCHPP + rcall TO_PRINTABLE + rcall EMIT_A +DOTID3: + rcall XNEXT + brcc DOTID1 + pop t1 + pop t0 + jmp DROP + + ; >pr c -- c Filter a character to printable 7-bit ASCII + fdw DOTID_L +TO_PRINTABLE_L: + .db NFA|3,">pr" +TO_PRINTABLE: + clr tosh + cpi tosl, 0 + brmi TO_PRINTABLE1 + cpi tosl, 0x20 + brpl TO_PRINTABLE2 +TO_PRINTABLE1: + ldi tosl, '.' +TO_PRINTABLE2: + ret + +;;;;;;;;;;;;;; +LIKEQ: + rcall CFETCHPP + rcall DOLIT + .dw 0x0f + rcall AND_ + rcall SWOP + rcall STORE_P + rcall SWOP + rcall CFETCHPP + rcall ROT + rcall OVER + rcall MINUS + rcall ONEPLUS + rcall FALSE_ + rcall MAX + rcall TOR + rjmp LIKEQ3 +LIKEQ1: + rcall TWODUP + rcall FETCH_P + rcall PPLUS + rcall SWOP + call CMP + breq LIKEQ3 +TWODROPNZ: + clz + rjmp LIKEQ4 +LIKEQ3: + rcall XNEXT + brcc LIKEQ1 +TWODROPZ: + sez +LIKEQ4: + pop t1 + pop t0 + rjmp TWODROP__ + +;;;;;;;;;;;;;;;;;;;; +LIKES: + rcall TWODUP + rcall LIKEQ + breq LIKES1 + rcall DUP + rcall DOTID + rcall SPACE_ +LIKES1: + rcall TWOMINUS + rcall FETCH_A + rcall DUPZEROSENSE + brne LIKES +TWODROP__: + jmp TWODROP + + ; WORDS -- filter + fdw TO_PRINTABLE_L +WORDS_L: + .db NFA|5,"words" + rcall BL + rcall WORD + rcall DUP + rcall DOLIT + fdw kernellink + rcall WDS1 + rcall LATEST_ + rcall FETCH_A +WDS1: rcall CR + jmp LIKES + +; .S -- print stack contents +; : .s space sp@ s0 @ 2- begin 2dup < while -@ u. repeat 2drop ; + fdw WORDS_L +DOTS_L: + .db NFA|2,".s",0 +DOTS: + rcall SPACE_ + rcall DUP + call SPFETCH + rcall S0 + rcall FETCH_A + rcall TWOMINUS +DOTS1: + rcall TWODUP + rcall LESS + rcall ZEROSENSE + breq DOTS2 + rcall MINUS_FETCH + rcall UDOT + rjmp DOTS1 +DOTS2: + rcall DROP + jmp TWODROP + +; DUMP ADDR U -- DISPLAY MEMORY + fdw DOTS_L +DUMP_L: + .db NFA|4,"dump",0 +DUMP: + rcall DOLIT + .dw 16 + rcall USLASH + rcall TOR + rjmp DUMP7 +DUMP1: + rcall CR + rcall DUP + rcall DOLIT + .dw 4 + rcall UDOTR + rcall DOLIT + .dw ':' + rcall EMIT_A + rcall DOLIT + .dw 15 + rcall TOR +DUMP2: + rcall CFETCHPP + rcall DOLIT + .dw 2 + rcall UDOTR + rcall XNEXT + brcc DUMP2 + pop t1 + pop t0 + + rcall DOLIT + .dw 16 + rcall MINUS + rcall DOLIT + .dw 15 + rcall TOR +DUMP4: + rcall CFETCHPP + rcall TO_PRINTABLE + rcall EMIT_A + rcall XNEXT + brcc DUMP4 + pop t1 + pop t0 +DUMP7: + rcall XNEXT + brcc DUMP1 + pop t1 + pop t0 + jmp DROP + +; IALLOT n -- allocate n bytes in ROM +; .dw link +;link set $ + .db NFA|1," " +IALLOT: + rcall IDP + jmp PLUSSTORE + + +;*************************************************************** +; Store the execcution vector addr to the return stack +; leave the updated return stack pointer on the data stack +; x>r ( addr rsp -- rsp' ) + fdw DUMP_L +X_TO_R_L: + .db NFA|3,"x>r" +X_TO_R: + movw zl, tosl + poptos + rcall TO_XA + adiw zl, 1 + st -z, tosl + st -z, tosh +.ifdef EIND + st -z, r_one +.endif + st -z, r_zero + movw tosl, zl + ret +;*************************************************************** + fdw X_TO_R_L +TO_XA_L: + .db NFA|3,">xa" +TO_XA: + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + ret + + fdw TO_XA_L +XA_FROM_L: + .db NFA|3,"xa>" +XA_FROM: + lsl tosl + rol tosh + add_pflash_tos + ret +;*************************************************************** + fdw XA_FROM_L +PFL_L: + .db NFA|3,"pfl" +PFL: + call DOCREATE + .dw OFLASH +;*************************************************************** + fdw PFL_L +ZFL_L: + .db NFA|3, "zfl" +ZFL: + call DOCREATE + .dw RAMPZV +;*************************************************************** +; ,?0= -- addr Compile ?0= and make make place for a branch instruction + .db NFA|4, ",?0=",0 ; Just for see to work ! +COMMAZEROSENSE: + sbrc FLAGS1, idup + rjmp COMMAZEROSENSE1 + rcall DOLIT + fdw ZEROSENSE + rjmp COMMAZEROSENSE2 +COMMAZEROSENSE1: + rcall IDPMINUS + rcall DOLIT + fdw DUPZEROSENSE +COMMAZEROSENSE2: + cbr FLAGS1, (1< while i, repeat 2drop ; + fdw INLINE_L +INLINEC_L: + .db NFA|3,"in," +INLINE0: + rcall FETCHPP + rcall DUP + rcall DOLIT + .dw 0x9508 + rcall NOTEQUAL + rcall ZEROSENSE + breq INLINE1 + rcall ICOMMA + rjmp INLINE0 +INLINE1: + jmp TWODROP + +; FOR -- bc-addr bra-addr + fdw INLINEC_L +FOR_L: + .db NFA|IMMED|COMPILE|3,"for" +FOR: + call DOCOMMAXT + fdw TOR + rcall IHERE + rcall FALSE_ + rcall RJMPC + rcall IHERE + jmp SWOP + +; NEXT bra-addr bc-addr -- + fdw FOR_L +NEXT_L: + .db NFA|IMMED|COMPILE|4,"next", 0 +NEXT: + rcall THEN_ + call DOCOMMAXT + fdw XNEXT + rcall BRCCC + + rcall AGAIN_ + + rcall DOLIT + fdw XNEXT1 + jmp INLINE0 +; (next) decrement top of return stack + .db NFA|7,"(next) " +XNEXT: + m_pop_zh + pop zh + pop zl + pop xh + pop xl + sbiw xl, 1 + push xl + push xh + mijmp + ret +XNEXT1: + pop t1 + pop t0 + ret + +; leave clear top of return stack + fdw NEXT_L +LEAVE_L: + .db NFA|COMPILE|5,"endit" +LEAVE: + m_pop_zh + pop zh + pop zl + pop t1 + pop t0 + push r_zero + push r_zero + mijmp +;*************************************************** +; RDROP compile a pop + fdw LEAVE_L +RDROP_L: + .db NFA|IMMED|COMPILE|5,"rdrop" +RDROP: + rcall DOLIT + fdw XNEXT1 + jmp INLINE0 +;*************************************************** + fdw RDROP_L +STOD_L: + .db NFA|3,"s>d" +STOD: + sbrs tosh, 7 + rjmp FALSE_ + rjmp TRUE_ +;*************************************************** + fdw STOD_L +DNEGATE_L: + .db NFA|7,"dnegate" +DNEGATE: + rcall DINVERT + call ONE + jmp MPLUS +;*************************************************** + fdw DNEGATE_L +QDNEGATE_L: + .db NFA|8,"?dnegate",0 +QDNEGATE: + rcall ZEROLESS + rcall ZEROSENSE + breq QDNEGATE1 + rcall DNEGATE +QDNEGATE1: + ret + +;*************************************************** + fdw QDNEGATE_L +DABS_L: + .db NFA|4,"dabs",0 +DABS: + rcall DUP + jmp QDNEGATE +;*************************************************** + fdw DABS_L +DPLUS_L: + .db NFA|2,"d+",0 +DPLUS: + ld xl, Y+ + ld xh, Y+ + ld t6, Y+ + ld t7, Y+ + ld t0, Y+ + ld t1, Y+ + add xl, t0 + adc xh, t1 + adc tosl, t6 + adc tosh, t7 + st -Y, xh + st -Y, xl + ret + +;*************************************************** + fdw DPLUS_L +DMINUS_L: + .db NFA|2,"d-",0 +DMINUS: + rcall DNEGATE + jmp DPLUS +;*************************************************** + fdw DMINUS_L +DTWOSLASH_L: + .db NFA|3,"d2/" + ld t0, y+ + ld t1, y+ + asr tosh + ror tosl + ror t1 + ror t0 + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DTWOSLASH_L +DTWOSTAR_L: + .db NFA|3,"d2*" + ld t0, y+ + ld t1, y+ + lsl t0 + rol t1 + rol tosl + rol tosh + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DTWOSTAR_L +DINVERT_L: + .db NFA|7,"dinvert" +DINVERT: + ld t0, y+ + ld t1, y+ + com t0 + com t1 + com tosl + com tosh + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DINVERT_L +DZEROEQUAL_L: + .db NFA|3,"d0=" +DZEROEQUAL: + ld xl, y+ + ld xh, y+ + or tosl, tosh + or tosl, xl + or tosl, xh + brne DZEROLESS_FALSE +DZEROEQUAL_TRUE: + ser tosl + ser tosh + ret + +;*************************************************** + fdw DZEROEQUAL_L +DZEROLESS_L: + .db NFA|3,"d0<" +DZEROLESS: + ld xl, y+ + ld xh, y+ + cpi tosh, 0 + brmi DZEROEQUAL_TRUE +DZEROLESS_FALSE: + clr tosl + clr tosh + ret +;*************************************************** + fdw DZEROLESS_L +DEQUAL_L: + .db NFA|2,"d=",0 + rcall DMINUS + jmp DZEROEQUAL +;*************************************************** + fdw DEQUAL_L +DLESS_L: + .db NFA|2,"d<",0 +DLESS: + rcall DMINUS + jmp DZEROLESS +;*************************************************** + fdw DLESS_L +DGREATER_L: + .db NFA|2,"d>",0 +DGREATER: + call TWOSWAP + jmp DLESS +;*************************************************** + fdw DGREATER_L +UDDOT_L: + .db NFA|3,"ud." + rcall LESSNUM + rcall NUMS + rcall NUMGREATER + call TYPE + jmp SPACE_ +;*************************************************** + fdw UDDOT_L +DDOT_L: + .db NFA|2,"d.",0 + rcall LESSNUM + push tosl ; dup >r + push tosh + rcall DABS + rcall NUMS + call RFROM + rcall SIGN + rcall NUMGREATER + call TYPE + jmp SPACE_ +;**************************************************** + fdw DDOT_L +MEMHI_L: + .db NFA|2,"hi",0 +MEMHI: + rcall DOLIT + fdw FLASHHI + call CSE_ + call PLUS + jmp FETCH +FLASHHI: + .dw FLASH_HI + .dw EEPROM_HI + .dw RAM_HI + +.if FLASHEND > 0x3fff +;;; x@ ( addrl addru -- x ) + fdw A_FROM_L +XFETCH_L: + .db NFA|2, "x@",0 +.ifdef RAMPZ + out_ RAMPZ, tosl +.endif + poptos + movw z, tosl + lpm_ tosl, z+ ; Fetch from Flash directly + lpm_ tosh, z+ +.ifdef RAMPZ + ldi t0, RAMPZV + out_ RAMPZ, t0 +.endif + ret + +;;; x! ( x addrl addru -- ) + fdw XFETCH_L +XSTORE_L: + .db NFA|2, "x!",0 + mov t0, tosl + call DROP + rcall XUPDATEBUF + rjmp ISTORE1 +.endif + +;*************************************************** + + fdw MEMHI_L +L_FETCH_P: + .db NFA|INLINE|2,"@p", 0 +FETCH_P: + pushtos + movw tosl, pl + ret +;*************************************************** + fdw L_FETCH_P +L_PCFETCH: + .db NFA|3,"pc@" ; ( -- c ) Fetch char from pointer +PCFETCH: + pushtos + movw tosl, pl + jmp CFETCH +;*************************************************** + fdw L_PCFETCH +L_PTWOPLUS: +kernellink: + .db NFA|INLINE|3,"p2+" ; ( n -- ) Add 2 to p +PTWOPLUS: + add pl, r_two + adc ph, r_zero + ret + +;*************************************************** +; marker --- name + .dw 0 +L_MARKER: +lastword: + .db NFA|6,"marker",0 +MARKER: + call ROM_ + rcall CREATE + rcall DOLIT + .dw dp_start + call HERE + rcall TEN + rcall CMOVE + rcall TEN + call ALLOT + call FRAM + rcall XDOES + call DODOES + rcall INI + rcall TEN + jmp CMOVE + +.if IDLE_MODE == 1 +.if CPU_LOAD_LED == 1 +;;; Enable load led + fdw BUSY_L +LOADON_L: + .db NFA|5,"load+" + sbr FLAGS2, (1<>8)&0xff +; de dpeeprom&0xff, (dpeeprom>>8)&0xff +; de (dpdata)&0xff, ((dpdata)>>8)&0xff +; de lastword_lo, lastword_hi +; de DOTSTATUS;&0xff;, (DOTSTATUS>>8)&0xff + +; .end +;********************************************************** +.cseg +.org BOOT_START +RESET_: jmp WARM_ +.org BOOT_START + 0x02 + rcall FF_ISR +.org BOOT_START + 0x04 + rcall FF_ISR +.org BOOT_START + 0x06 + rcall FF_ISR +.org BOOT_START + 0x08 +.if MS_TIMER_ADDR == 0x08 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x0a + rcall FF_ISR +.org BOOT_START + 0x0c + rcall FF_ISR +.org BOOT_START + 0x0e +.if MS_TIMER_ADDR == 0x0e + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x10 + rcall FF_ISR +.org BOOT_START + 0x12 +.if MS_TIMER_ADDR == 0x12 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x14 +.if MS_TIMER_ADDR == 0x14 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x16 +.if MS_TIMER_ADDR == 0x16 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x18 +.if MS_TIMER_ADDR == 0x18 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1a +.if MS_TIMER_ADDR == 0x1a + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1c +.if MS_TIMER_ADDR == 0x1c + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1e +.if MS_TIMER_ADDR == 0x1e + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x20 +.if MS_TIMER_ADDR == 0x20 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x22 +.if MS_TIMER_ADDR == 0x22 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x24 + rcall FF_ISR +.if 0x26 < INT_VECTORS_SIZE +.org BOOT_START + 0x26 + rcall FF_ISR +.endif +.if 0x28 < INT_VECTORS_SIZE +.org BOOT_START + 0x28 + rcall FF_ISR +.endif +.if 0x2a < INT_VECTORS_SIZE +.org BOOT_START + 0x2a +.if MS_TIMER_ADDR == 0x2a + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.endif +.if 0x2c < INT_VECTORS_SIZE +.org BOOT_START + 0x2c + rcall FF_ISR +.endif +.if 0x2e < INT_VECTORS_SIZE +.org BOOT_START + 0x2e + rcall FF_ISR +.endif +.if 0x30 < INT_VECTORS_SIZE +.org BOOT_START + 0x30 + rcall FF_ISR +.endif +.if 0x32 < INT_VECTORS_SIZE +.org BOOT_START + 0x32 + rcall FF_ISR +.endif +.if 0x34 < INT_VECTORS_SIZE +.org BOOT_START + 0x34 + rcall FF_ISR +.endif +.if 0x36 < INT_VECTORS_SIZE +.org BOOT_START + 0x36 + rcall FF_ISR +.endif +.if 0x38 < INT_VECTORS_SIZE +.org BOOT_START + 0x38 + rcall FF_ISR +.endif +.if 0x3a < INT_VECTORS_SIZE +.org BOOT_START + 0x3a + rcall FF_ISR +.endif +.if 0x3c < INT_VECTORS_SIZE +.org BOOT_START + 0x3c + rcall FF_ISR +.endif +.if 0x3e < INT_VECTORS_SIZE +.org BOOT_START + 0x3e + rcall FF_ISR +.endif +.if 0x40 < INT_VECTORS_SIZE +.org BOOT_START + 0x40 + rcall FF_ISR +.endif +.if 0x42 < INT_VECTORS_SIZE +.org BOOT_START + 0x42 + rcall FF_ISR +.endif +.if 0x44 < INT_VECTORS_SIZE +.org BOOT_START + 0x44 + rcall FF_ISR +.endif +.if 0x46 < INT_VECTORS_SIZE +.org BOOT_START + 0x46 + rcall FF_ISR +.endif +.if 0x48 < INT_VECTORS_SIZE +.org BOOT_START + 0x48 + rcall FF_ISR +.endif +.if 0x4a < INT_VECTORS_SIZE +.org BOOT_START + 0x4a + rcall FF_ISR +.endif +.if 0x4c < INT_VECTORS_SIZE +.org BOOT_START + 0x4c + rcall FF_ISR +.endif +.if 0x4e < INT_VECTORS_SIZE +.org BOOT_START + 0x4e + rcall FF_ISR +.endif +.if 0x50 < INT_VECTORS_SIZE +.org BOOT_START + 0x50 + rcall FF_ISR +.endif +.if 0x52 < INT_VECTORS_SIZE +.org BOOT_START + 0x52 + rcall FF_ISR +.endif +.if 0x54 < INT_VECTORS_SIZE +.org BOOT_START + 0x54 + rcall FF_ISR +.endif +.if 0x56 < INT_VECTORS_SIZE +.org BOOT_START + 0x56 + rcall FF_ISR +.endif +.if 0x58 < INT_VECTORS_SIZE +.org BOOT_START + 0x58 + rcall FF_ISR +.endif +.if 0x5a < INT_VECTORS_SIZE +.org BOOT_START + 0x5a + rcall FF_ISR +.endif +.if 0x5c < INT_VECTORS_SIZE +.org BOOT_START + 0x5c + rcall FF_ISR +.endif +.if 0x5e < INT_VECTORS_SIZE +.org BOOT_START + 0x5e + rcall FF_ISR +.endif +.if 0x60 < INT_VECTORS_SIZE +.org BOOT_START + 0x60 + rcall FF_ISR +.endif +.if 0x62 < INT_VECTORS_SIZE +.org BOOT_START + 0x62 + rcall FF_ISR +.endif +.if 0x64 < INT_VECTORS_SIZE +.org BOOT_START + 0x64 + rcall FF_ISR +.endif +.if 0x66 < INT_VECTORS_SIZE +.org BOOT_START + 0x66 + rcall FF_ISR +.endif +.if 0x68 < INT_VECTORS_SIZE +.org BOOT_START + 0x68 + rcall FF_ISR +.endif +.if 0x6a < INT_VECTORS_SIZE +.org BOOT_START + 0x6a + rcall FF_ISR +.endif +.if 0x6c < INT_VECTORS_SIZE +.org BOOT_START + 0x6c + rcall FF_ISR +.endif +.if 0x6e < INT_VECTORS_SIZE +.org BOOT_START + 0x6e + rcall FF_ISR +.endif +.if 0x70 < INT_VECTORS_SIZE +.org BOOT_START + 0x70 + rcall FF_ISR +.endif + +.org BOOT_START + INT_VECTORS_SIZE - 1 +FF_ISR_EXIT: + pop tosh + pop tosl + pop t1 + pop t0 + pop zh + pop zl +MS_TIMER_ISR_EXIT: + ld xl, y+ + ld xh, y+ + out_ SREG, xh + ld xh, y+ + reti + +FF_ISR: +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 + out_ TCCR1B, r_one ; Start load counter +.endif +.endif + st -y, xh + in_ xh, SREG + st -y, xh + st -y, xl + m_pop_xh + pop xh + pop xl + push zl + push zh + push t0 + push t1 + push tosl + push tosh +.if low(ivec) == 0x80 + ldi xh, low(ivec-1) + add xl, xh +.else + subi xl, 1 +.endif + ldi xh, high(ivec) + ld zl, x+ + ld zh, x+ + mijmp ;(z) + +;;; ************************************************* +MS_TIMER_ISR: +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 + out_ TCCR1B, r_one ; Start load counter +.endif +.endif + st -y, xh + in_ xh, SREG + st -y, xh + st -y, xl + add ms_count, r_one + adc ms_count1, r_zero +.if CPU_LOAD == 1 +LOAD_ADD: + in_ xl, TCNT1L + in_ xh, TCNT1H + out_ TCNT1H, r_zero + out_ TCNT1L, r_two + + add loadreg0, xl + adc loadreg1, xh + adc loadreg2, r_zero + + tst ms_count + brne LOAD_ADD_END + sbr FLAGS2, (1<a",0 +TO_A: + mov al, tosl + mov ah, tosh + poptos + ret + + fdw TO_A_L +STORE_L: + .db NFA|1, "!" +STORE: + cpi tosh, high(PEEPROM) + brcc STORE1 +STORE_RAM: + movw zl, tosl + poptos +STORE_RAM_2: + std Z+1, tosh + std Z+0, tosl + poptos + ret +STORE1: + rcall LOCKEDQ + cpi tosh, high(OFLASH) + brcc ISTORE +ESTORE: + call TWODUP + rcall ECSTORE + adiw tosl, 1 + ldd t0, Y+1 + std y+0, t0 + rjmp ECSTORE + +LOCKEDQ: + sbrs FLAGS1, fLOCK + ret + rcall DOTS + call XSQUOTE + .db 3,"AD?" + call TYPE + rjmp STARTQ2 ; goto ABORT + +;*********************************************************** +IFETCH: + movw z, tosl + sub_pflash_z +.ifdef RAMPZ + lds t0, ibaseu + cpi t0, RAMPZV + brne IIFETCH +.endif + cpse zh, ibaseh + rjmp IIFETCH + mov t0, zl + andi t0, ~(PAGESIZEB-1) + cp t0, ibasel + brne IIFETCH + ldi xl, low(ibuf) + ldi xh, high(ibuf) + andi zl, (PAGESIZEB-1) + add xl, zl + ld tosl, x+ + ld tosh, x+ + ret +IIFETCH: + lpm_ tosl, z+ ; Fetch from Flash directly + lpm_ tosh, z+ + ret + + fdw STORE_L +A_FROM_L: + .db NFA|2, "a>",0 +A_FROM: + pushtos + mov tosl, al + mov tosh, ah + ret + +.if FLASHEND > 0x3fff + fdw XSTORE_L +.else + fdw A_FROM_L +.endif +FETCH_L: + .db NFA|1, "@" +FETCH: + cpi tosh, high(PEEPROM) + brcc FETCH1 +FETCH_RAM: + movw zl, tosl +FETCH_RAM_2: + ld tosl, z+ + ld tosh, z+ + ret +FETCH1: + cpi tosh, high(OFLASH) + brcc IFETCH +EFETCH: + sbic eecr, eewe + rjmp EFETCH + subi tosh, high(PEEPROM) + out eearl, tosl + out eearh, tosh + sbi eecr, eere + in t0, eedr + inc tosl + out eearl, tosl + sbi eecr, eere + in tosh, eedr + mov tosl, t0 + ret + +ICFETCH: + rcall IFETCH + clr tosh + ret + + fdw FETCH_L +CFETCH_L: + .db NFA|2, "c@",0 +CFETCH: + cpi tosh, high(PEEPROM) + brcc CFETCH1 +CFETCH_RAM: + movw zl, tosl + ld tosl, z+ + clr tosh + ret +CFETCH1: + cpi tosh, high(OFLASH) + brcc ICFETCH +ECFETCH: + rcall EFETCH + clr tosh + ret + +ICSTORE: + rcall IUPDATEBUF + poptos + ldi xl, low(ibuf) + ldi xh, high(ibuf) + lds t0, iaddrl + andi t0, (PAGESIZEB-1) + add xl, t0 + st x+, tosl +ICSTORE_POP: + sbr FLAGS1, (1< 16/16 division +umslashmod0: + clt + tst tosl + brne umslashmodstart + tst tosh + brne umslashmodstart + set ; Set T flag + jmp WARM_ +umslashmodstart: + movw t4, tosl + + ld t3, Y+ + ld t6, Y+ + + ld tosl, Y+ + ld tosh, Y+ + +; unsigned 32/16 -> 16/16 division + ; set loop counter + ldi t0,$10 ;6 + +umslashmod1: + ; shift left, saving high bit + clr t7 + lsl tosl + rol tosh + rol t3 + rol t6 + rol t7 + + ; try subtracting divisor + cp t3, t4 + cpc t6, t5 + cpc t7,r_zero + + brcs umslashmod2 + + ; dividend is large enough + ; do the subtraction for real + ; and set lowest bit + inc tosl + sub t3, t4 + sbc t6, t5 + +umslashmod2: + dec t0 + brne umslashmod1 ;16=17=272 + +umslashmod3: + ; put remainder on stack + st -Y,t6 + st -Y,t3 + ; Quotient is already in tos ; 6 + 272 + 4 =282 cycles + ret +BASEQV: + fdw DECIMAL + fdw HEX + fdw BIN + + +;;; ************************************* +;;; EMPTY dictionary data +; ******************************************************************* +.equ coldlitsize=12 +COLDLIT: +STARTV: .dw 0 +DPC: .dw OFLASH +DPE: .dw ehere +DPD: .dw dpdata +LW: fdw lastword +STAT: fdw DOTSTATUS +;******************************************************************* +; BOOT sector END ************************************************** + +KERNEL_END: diff --git a/forth/firmware/ff_uno.hex b/forth/firmware/ff_uno.hex new file mode 100644 index 0000000..b0ab0b3 --- /dev/null +++ b/forth/firmware/ff_uno.hex @@ -0,0 +1,531 @@ +:020000020000FC +:105F00000E94B93209C00E9408300E94EB320E9400 +:105F1000FA3311F00C9464390E94953AA0F70C946E +:105F200060390002A1024402F0F83EF97EF90A004D +:105F3000A50280DF000000000000000003028120B5 +:105F40000E9447310E94D837C2FE0E94DE320E9472 +:105F500019370E9481350E94D8370F000C942633E0 +:105F600000008465786974000F910F910895A4FA78 +:105F7000886F70657261746F72000E94E03080DF1C +:105F800003020000400060005A0062DF8469646C14 +:105F90006500706408958CDF8462757379007F7B7F +:105FA00008958CFE846D73657400FC01899199914C +:105FB0000081082B0083899199910895A4DF846D55 +:105FC000636C7200FC01899199910081809508238E +:105FD0000083899199910895BEDF866C7368696624 +:105FE0007400FC018991999131971AF0880F991FDB +:105FF000FBCF0895DADF8672736869667400FC016E +:106000008991999131971AF096958795FBCF0895CC +:1060100078D5A7D276D5A5C2F6DF826E3D00F8DF2F +:106020008F7079D3E7D3B1F03FD36BD5A2D20CC038 +:10603000EFDF6CD3DFD321F066D70E94A53A04C00E +:10604000ACD2D8D309F456D70E94953A88F71F915D +:106050000F9101C058D70FD40C943B341AE08473CD +:106060006B69700086D2CCD389F073D226D4A9D7BD +:106070009FD7090050D3BED329F48FD24CD3BAD3C3 +:1060800029F001C055D2C4D1E7D4EDCF0F910F91C3 +:1060900008955EE0847363616E0062D36AD210C0BB +:1060A00030D58FD785D7090036D3A4D311F040D28D +:1060B00005C00E94663B2FD39DD311F0F5D203C0DB +:1060C0000E94953A68F75FD2EAD255D3089594E0DA +:1060D000846D74737400FC0181910991199180237E +:1060E00099270895D0E0834663796AD0803E837310 +:1060F000703F89D00E940E399CD60E94093999D6EA +:10610000CED2FAD2D9D10353503F3ED70895E6E01C +:1061100084656D6974005ED30C94AB3010E1836BC1 +:1061200065795ED30C94AB301EE1846B65793F00DA +:106130005DD30C94AB302AE187657865637574652F +:10614000FC01F058899199918894F795E795099405 +:1061500038E1834065786DD60C94A03052E18876A2 +:1061600061726961626C65009CD0B1D0DAD10C9427 +:10617000CB305EE189327661726961626C6591D083 +:1061800017D70400CED10C94CB3074E188636F6EC6 +:106190007374616E7400D6D70E941D3E0C94B038A3 +:1061A0008CE18932636F6E7374616E74C8D1CAD723 +:1061B0000E941D3E0E941D3E0C94B0388328632926 +:1061C000FF91EF910CD0FF91EF91099483286429FE +:1061D000BF91AF91FF91EF9102D0FD0109949A9385 +:1061E0008A93EE0FFF1F85919591089583282C299E +:1061F000FF91EF91F4DFF795E795EF93FF9398C048 +:10620000A2E183737040FE019A938A93CF010895AF +:1062100083737021EC01089583727030BF91AF9148 +:106220000E940E3906D68DBF9EBF89919991FD01BE +:10623000099402E2B37270409A938A938DB79EB725 +:10624000089534E2A23E3C00082F892F902F089534 +:1062500044E285666C6173685092E501089552E2EC +:1062600086656570726F6D007092E501089560E259 +:106270008372616D04E00093E501089570E2826429 +:10628000700035D704D00C94DE32836373659A9323 +:106290008A938091E501992708957EE2846865726A +:1062A0006500EFDF0C94863E9CE2812CFADF37D448 +:1062B0000ED00C949132AAE282632C00F2DF01D35B +:1062C000A7D00C949132B8E28463656C6C009A9309 +:1062D0008A9382E090E00895C8E285616C69676EF8 +:1062E000E0DF08D0CEDF0C944C3EDAE287616C69C7 +:1062F000676E656401968E7F0895ECE2A563656C18 +:106300006C2B02960895FCE2A563656C6C73880F94 +:10631000991F089508E3A5636861722B019608959B +:1063200016E3A56368617273089522E38363662CA4 +:1063300048D674D650D13DD13BD6F00FF6D15AD2C3 +:1063400049F036D60E940E943E3F90588894979517 +:10635000879506C063D63FD13ED7BCD19F70906D64 +:106360000C943E3F82213A0023D6FAFF0C94C739A1 +:106370002CE38232400025D65CD5E1D0C2DF0C94FC +:10638000193772E382322100DAD0E3D0BADFC7D303 +:106390000C944C3E84E3853264726F70C9D00C94C7 +:1063A000983296E3843264757000D3D00C94A9328D +:1063B000A4E3853273776170D4D0DBD0D2D0E3D040 +:1063C0000895B2E38573706163650AD70C948B30CE +:1063D000C4E3867370616365730012D219F0F5DF50 +:1063E00063D1FBCF0C949832D2E384756D696E0053 +:1063F000DCDFA8D106C0EAE384756D617800D5DFE3 +:106400009AD1F8D109F09BD00C949832F8E38131FD +:106410009A938A9381E090E008950EE48661636325 +:106420006570740096D0CAD094D07BDE8D3029F48C +:106430006AD52FD046D27CD026C08A3049F478D095 +:1064400028D03BD2D7D1F9F055D523D03AD2EDCFD1 +:1064500051D51FD036D2B5D55EDEB3D5A9D508004B +:106460005AD1C8D139F064D01FD183D072D08BD02B +:10647000C6DFDBCF6ED025D212D16BD0B9DF95DF6E +:1064800045D1B8D191F6F7D15AD00C94EB3283664E +:106490006372CFD2F5FF1CE484747970650069D013 +:1064A00002C02FD338DE0E94953AD8F71F910F9182 +:1064B0000C94983283287322FF91EF91EE0FFF1F07 +:1064C00005919A938A93CF0190589A938A93802F3B +:1064D0009927E00FF91F31968894F795E79509946D +:1064E00098E4D273220084DEB8E4B6DE05D00C94C2 +:1064F0003A31E2E4822C22005BD52200C0D2D1DE08 +:1065000028D0CDD0F7DE0DD00C947835F4E4D22E1F +:106510002200E9DF6DDE9EE408950EE585616C6C76 +:106520006F74AFDE0C9470331CE5A464726F70005E +:106530008991999108952AE5847377617000099192 +:1065400019919A938A93C801089538E5846F766506 +:1065500072009A938A938A819B8108954CE5837295 +:106560006F7407D0ECDF0FD00C949F325EE5923E43 +:106570007200FF91EF918F939F9389919991099464 +:106580006EE592723E00FF91EF919A938A939F91EC +:106590008F91099482E592724000FF91EF919A9356 +:1065A0008A939F918F918F939F930994BEEF8361FC +:1065B000627307D50C944A34AEE5812B0991199189 +:1065C000800F911F0895BAE5826D2B00D0D70C94EF +:1065D000D93AC8E5812D09911991081B190BC801F9 +:1065E00008950090D7011090D8010895FADF009423 +:1065F0001094060C151C0BD001C008D0906521D05A +:10660000E0D4812D07D0806990641BC0EADFF7D603 +:10661000F6D6802D982F92958F709F708068089580 +:10662000F5DF90670ED0CDD4812DF4DF80699067BF +:1066300008C0ECDF906605D0C4D4812DEBDF806903 +:1066400090660C943E3FD4E583616E640991199184 +:1066500080239123089548E6826F72000991199171 +:10666000802B912B089558E683786F7209911991C8 +:1066700080279127089568E6A6696E766572740092 +:1066800080959095089578E6866E656761746500DB +:10669000809590950196089588E6A2312B00019689 +:1066A00008959AE6A2312D0001970895A4E6A2323A +:1066B0002B0002960895AEE6A53E626F64790496BB +:1066C0000895B8E6A2322A00880F991F0895C4E6FB +:1066D000A2322F00959587950895D0E6822B210050 +:1066E0002EDF37DFA6D36ADF2ADF0C944C3EDCE6D0 +:1066F0008677697468696E002CDF6DDF3ADF6BDFC7 +:1067000042DF0C949B33F0E6823C3E0004D00C94B4 +:10671000E737D8EF813D5FDF0C94E73714E7813C22 +:106720005ADF0C94EE371EE7813E09DF0C9490335C +:1067300028E782753C004FDF880B990B089532E7FC +:1067400082753E00FCDE0C949B3340E78221700092 +:10675000AC018991999108954CE79421703E7200A3 +:10676000FF91EF914F935F93AC01899199910994B7 +:106770005AE793723E70FF91EF915F914F910994A8 +:1067800072E7827040009A938A93CA010C94863E05 +:1067900082E7827021009A938A93CA010C944C3E3E +:1067A00092E7837063219A938A93CA010C94BB3E4B +:1067B000A2E7A2702B00460D551D0895B2E7837025 +:1067C0002B2B480F591F899199910895BEE7852772 +:1067D000656D69742ED1E8FFCEE784276B6579007B +:1067E00028D1EAFFDAE785276B65793F22D1ECFFF4 +:1067F000833F303D00978991999108958364303D9E +:1068000000970895E6E783756D2A0C94643F06E8C7 +:1068100086756D2F6D6F64000C947D3F10E8857553 +:106820002F6D6F6467D38BDE0C947D3F1EE8812A49 +:10683000ECDF0C9498322EE882752F00F3DF0C9475 +:106840003B3438E886752A2F6D6F640092DEDDDFF9 +:106850009ADE0C940C3444E8812FA7DD07DF89DE33 +:10686000A8DE6DDEA6DE6BDEE9DF8DDE0C944A3439 +:1068700058E8A36E697009910991089572E88474CB +:1068800075636B005CDE0C94A9327EE8873F6E6511 +:1068900067617465A3D3AEDF09F0FADE08958CE872 +:1068A000836D617882DD3CDFACCDA0E8836D696EDD +:1068B0007CDD3BDFA6CD826340000C94A13E826369 +:1068C00021000C94BB3EACE88275700079DC0200BC +:1068D000C8E884686F6C640016D392D001DF90D052 +:1068E000A8D20C94BB3ED2E8823C23008ED088D044 +:1068F0000C944C3EE8E88564696769748A300CF052 +:106900008796C0960895F6E8812387D092D282D1E7 +:1069100028DEF4DF0C946C3408E982237300F5DF81 +:1069200044DD9CDE67DFD9F708951AE982233E0033 +:1069300035DD66D07ED269D00CDE0C94EB322CE9CA +:10694000847369676E0090301AF432D32D00C4DF6F +:106950000C94983240E982752E00C8DFCBD2DFDF7D +:10696000E7DF9DDD0C94E53156E983752E72BEDFBD +:106970009BDEFFDDBFD201C0C8DFD7D5E8F71F918E +:106980000F91CDDFD5DF8BDD0C94E5316AE9812EE7 +:10699000ADDF17D30EDEAED2C2DFE3DDD4DFC8DF5A +:1069A0007EDD0C94E5318EE987646563696D616C09 +:1069B00079D233D00C944C3EA8E983686578F8D23C +:1069C00010002BD00C944C3EBAE98362696E7FDCD8 +:1069D00024D00C944C3ECAE985727361766529D047 +:1069E000FEFFD8E985756C696E6B23D0FCFFE4E986 +:1069F000847461736B001DD0F2FFF0E9826870004F +:106A000018D00000FCE9837061647BD172D10C94D2 +:106A1000DE3206EA8462617365000BD0EEFF14EA91 +:106A200084757365720017D352DC32DEB0D409DE90 +:106A300064D3FF91EF91D3DB820D931D089520EA7B +:106A400086736F75726365006ED10C94BB3140EA3A +:106A5000872F737472696E6772DD7BDDBCDD89DD43 +:106A6000ADDD91DD089550EAC15CEEDF55D157D020 +:106A700060640C94983268EA857061727365A1D283 +:106A8000E3DF4AD1D6D1E8DF8F939F936ADDEADA5C +:106A900060DD6FDD66DD01DBB3DE09F005DE73DD91 +:106AA00072DD5FDD98DD38D11BDEECDE0C94EB325D +:106AB00078EA84776F726400E2DF41DDF5DDE2DEC3 +:106AC0000C94BB3EB2EA85636D6F766538DD48DEB7 +:106AD00050DD03C016D067DE6EDE27D5D8F71F91D4 +:106AE0000F9149DE0C949832C6EA85706C6163653B +:106AF0005CDCE7DE13DC23DD0C946635EAEA8363B5 +:106B0000402B5FD2CCDD1BDD0C94A13EFEEA82401F +:106B10002B0057D2CEDD13DD0C94863E81210C94E0 +:106B20004C3E0EEB836E3E63ECDF8F7047DD0C94C2 +:106B30007A3124EB83633E6E4ED343D2BEDE0E9495 +:106B4000453E27FFC9F3089534EB832866292DDCE1 +:106B500066DA56DE21F0ECDC3ED36BD132D24ADE6F +:106B6000B1F74EDE41F087DE2CD2DEDFE8DC09D063 +:106B70002ED24EDC73DD08954AEB86696D6D656437 +:106B80003F009BDE982E807408957AEB8466696ED0 +:106B900064000ED2E6F6DBDF33DE21F4C9DC33D34A +:106BA00048D1D5DF08958CEB8664696769743F002E +:106BB00080340CF08797C0970AF49CC102D22DDF75 +:106BC00038D10C949033A8EB857369676E3FC1DCB4 +:106BD00074DE082FADDC0D3219F00B3219F003C052 +:106BE00004D091C102D00C947A3712DC0C942C356D +:106BF000C8EB8375642A8F939F9307DE99DC9FDC33 +:106C0000C2DC03DEAEDC0C94DE32F2EB8675642F60 +:106C10006D6F6400AEDC6ED1C0DCFEDDA2DCA1DCF9 +:106C2000B2DCFADD0C94B1320CEC873E6E756D620D +:106C3000657221E0E5DDD1F09CDC8F939F933DDE12 +:106C40008E3279F0B5DFD6DD21F472DC9CDC9BDC82 +:106C50000DC08FDCE2DEEDD0CEDF95DCB7DC20E0CE +:106C600001C066DC90DC8FDCC0DFE4CF820F0895CA +:106C70002AEC876E756D6265723FA3D13BD13AD124 +:106C800070DC3FDFA4DF75DCC8DED3D072DC61DCF2 +:106C900014DE8397833038F43ADB8AD13AFF8EDCF6 +:106CA0005ADAA3DF01C044DCC4DF6DDCB6DE37DFB7 +:106CB000A1DD29F068DC72DB71DB1CD111C001970A +:106CC000FCDD0E94453E5FDC95DD09F058D42E3294 +:106CD00021F447DC82E090E003C02ADCCCDD98DBC5 +:106CE00008958473776170000C949F3272EC837402 +:106CF000692381DE9ED008960C94863EEEEC837468 +:106D0000696205D00C94863EFEEC8374697591DE51 +:106D1000F0FF0AED833E696E8CDEFAFF14ED8727E3 +:106D2000736F7572636585DEF6FF4BD1FF91EF914E +:106D300056DAF795E795EFDC5DDD09941EED89697C +:106D40006E74657270726574EEDF1EDBD3D0E4DFA3 +:106D5000E6DEBDD645D2B0DE34D1AFDD4BDD09F481 +:106D600064C017DF4DDD09F445C099DC40D22FD156 +:106D700075DC40DD99F094FE0AC039D29DDB0C43EE +:106D80004F4D50494C45204F4E4C5900FDD06F7B24 +:106D9000D7D966FDDECF6F7E6F7D2AC06F7EC5DFDF +:106DA000CEEF11F0606120C067FF14C0BEDF4CE67B +:106DB00011F036DC1DC0B9DF5CE611F03ADC18C01A +:106DC000B4DFBCE511F012DC13C0AFDFD6E511F083 +:106DD00014DC0EC06F7DA9DFC2EF09F0606295FE82 +:106DE00003C00E946C3A04C025D16D7F94FC6260A0 +:106DF0006F77AFCF6F749CDB40DF02DD81F0F7D19E +:106E0000F9DC59F0082F8991999101FF03C06CDFDB +:106E10000E941D3E0E941D3E9CCF8ADBE9CF88DB8D +:106E200045D06FDE3CDB66D0A6D051D60C949832AC +:106E300081400C94863E3EED83736862E4D1F9DFB5 +:106E4000C0D03BDD8EDB0ADC4FDF0C94BB3E38EE5E +:106E500089696D6D656469617465AAD040000C94A0 +:106E60001E3750EE87696E6C696E6564A1D0200094 +:106E70000C941E3764EE832E73749AD03C004BD969 +:106E80000E94503F48D994D02C0045D90E94A02F91 +:106E900006DB8ED03E003FD90C948639823E7200CC +:106EA0000C94B9328DD90A008364703E81D00009F8 +:106EB000B9D1F8DF0C946635833E647079D000094F +:106EC0004FDCB0D175D0040054DB23DE7AD05BDC1C +:106ED0001DDC90DC11F05FDC01C02ADB06D425D379 +:106EE000A0F71F910F9147DC0C94983276EE8566DF +:106EF000616C73659A938A93882799270895EEEEBB +:106F00008474727565009A938A938FEF9FEF08954A +:106F100000EF84717569740081D90AD1ABD9C6DFDD +:106F2000E8D88DD0EEDE4DD0E4DE0A977BDA4DDA7C +:106F30000BDF5DD15FDCA1F7B9D5C0DFBDDA03207F +:106F40006F6BADDA07D00C948F3712EF8670726FCB +:106F50006D7074000E94F33E0A094CEF8561626F08 +:106F6000727457D166DF56D90C948C375CEF873F2B +:106F700061626F72743FA0DA013F0C94C4376EEF08 +:106F8000863F61626F727400ECDA34DC19F41DDA4A +:106F900086DAE7DF0C94CE3180EFD661626F7274CF +:106FA0002200A1DA25D988EF08959AEF836C6974DD +:106FB000FF91EF9114D9F795E795099496E5A364AD +:106FC00075709A938A93089508E782303D0001977F +:106FD000880B990B0895CAEF82303C00990F880BFB +:106FE000990B0895ACEF8127FBD066DDD2DD0C94C0 +:106FF000BB37E6EF846368617200F2D040DD98DA57 +:107000000C94A13EF4EFC128D3DF290038DD606481 +:107010000C94CE3106F085696865726568D009CF39 +:1070200016F0D65B636861725D00E7DF0C941D3E6D +:107030008363662C0C94983122F082637200B8DF6F +:107040000D0069D8B5DF0A000C948B303AF08663E6 +:10705000726561746500C4D02FDDB3DF9ADD0BDC8F +:10706000B6DF2ADA0F414C52454144592044454687 +:10707000494E454489DFA5DF20DCCAD999DF1000DD +:107080003BDB79DFCBDF36D932D049DDBCD0D1DE76 +:10709000D8DA37DDC3DF95DFB6D041DD29DDBEDFCD +:1070A0000CDC86DF8000CADEFADA24D970D180DFFA +:1070B000C0E147D915D9F5D8EAD89CDB09F4F9DA4B +:1070C0000C943E3F4EF0D8706F7374706F6E650015 +:1070D00087D0F2DC5EDD75DF4EDF80DF8BDB19F001 +:1070E00087D8F0E1AECA0C9498318369647068D88F +:1070F000DB018728646F65733E2945DA84D099DE09 +:1071000013DDF5DF96DECCDEF2DF09DD880F991F97 +:1071100018D939DAECDF0C944C3EC6F0D5646F65B3 +:10712000733E66D8FAF064D8D0E108951CF1C15BD3 +:107130005092E60108952EF1815D6092E601089576 +:1071400038F1813A88DFF9DF0C94B43142F1873AA3 +:107150006E6F6E616D6562DF0C949D384EF1D13BB0 +:10716000E7DF61FD24C05ADF29D08C01107F105D5C +:1071700059F08991999122D08E509449B9F48CE0BC +:1071800094E9DDD90C944C3E76DB9F7093FD906FB3 +:107190009BDA44DF13DA0CDFFEFFF9D009DF0C9431 +:1071A00008D0905888949795879503C0F7D800DF4A +:1071B00008950C943E3F5EF1822D40000CD001DF1B +:1071C0000C94863EB8F1D35B275D0EDF0C941D3E18 +:1071D000C6F1A2322D0002970895D2F182626C00AE +:1071E0000E94E0302000DCF18573746174659A932D +:1071F0008A938091E6019091E6010895E8F1866C0A +:107200006174657374000E94E030E101FEF18273E5 +:1072100030000FDCE4FF0EF2827230000ADCE6FF81 +:1072200083696E690E94E030D90118F28574696340 +:107230006B739A938A930FB7F8948E2D9F2D0FBF7F +:1072400008952CF2826D7300F4DFB8D9F6D5B9DE5B +:10725000F0DFC1D9C3DECEDAC9F30C94983244F220 +:10726000832E69644EDC8F7084D903C04ADC0AD057 +:10727000EBDE5BD1D8F71F910F910C94983260F23E +:10728000833E70729927803012F080320AF48EE2C9 +:10729000089537DC8DDE0F00D9D951D959DA4FD98D +:1072A00030DC5FD956D997D9FAD924DEFBDA61D917 +:1072B00009C07BD80BD27FDA42D90E94802F11F00F +:1072C000989403C032D1A8F718941F910F910AC067 +:1072D0006CD8DFDF19F075DEC5DF77D87CDFA9DD7C +:1072E0008FDAB1F70C94CE3180F285776F726473C8 +:1072F00077DFE2DB66DE5CDEE6F602D084DF99DD76 +:107300009EDE0C946839EAF2822E73005ED859DE54 +:107310000E9403317EDF8DDD5EDF47D801DA6ADA55 +:1073200019F04CDF1ADBF9CF03D90C94CE3108F3F6 +:107330008464756D70003CDE100080DA1AD920C0BC +:107340007EDE3FDE35DE040012DB32DE3A007CDE1C +:107350002FDE0F000ED9D5DB2BDE020008DBE5D0D7 +:10736000D0F71F910F9124DE100035D921DE0F00D8 +:1073700000D9C7DB87DF68DED8D0D8F71F910F911F +:10738000D4D0F0F61F910F910C9498328120AFDE8B +:107390000C94703330F383783E72FC01899199919B +:1073A00009D03196829392935292CF01089596F329 +:1073B000833E786190588894979587950895B0F3A7 +:1073C0008378613E880F991F90580895C0F38370A9 +:1073D000666C0E94E0300080CEF3837A666C0E9477 +:1073E000E0300000842C3F303D0065FD03C0E0DD4F +:1073F000F4E703C004D0DCDD00E86F7D6DC0D8DDAC +:10740000FCFFC5CF67D99F70906CD3CED1DD08F05B +:10741000D0CECEDD09F464FD9B7FCBCEDAF3D2690A +:10742000660064FDECDFE1DFF4DF6F7EF7DD62DD37 +:107430000C94023A1EF4D4656C736500EFDD5ADDDE +:10744000E1DF52DC0C94283A36F4D47468656E009F +:107450006260E4DD7ED8BFD8BEDE3CD9A9DD00C0C5 +:10746000FDD842DC0C944C3E4AF4D5626567696EE7 +:107470000C940E386AF4D5756E74696C626064FDA4 +:10748000BEDFB3DFC6DF6F7E0C944A3A76F4D56177 +:107490006761696E6260C2DD9ED89DDE0C94023A1F +:1074A0008EF4D57768696C65BCDF0C949F32A2F4CA +:1074B000D672657065617400EDDF0C94283AB0F403 +:1074C000D6696E6C696E65006F7E6F7D8DDD0C9484 +:1074D0006C3AC0F483696E2C1CDB73DD69DD0895A2 +:1074E00015D988D911F0CAD4F7CF0C94CE31D4F481 +:1074F000D3666F720E94F83072E590DDFBDC82DFAC +:107500008DDD0C949F32F0F4D46E65787400A0DFAA +:107510000E94F8302AF57ADFBDDF4ADD3CF50C9495 +:107520006C3A87286E6578742920FF91EF91BF919E +:10753000AF911197AF93BF93099408951F910F9145 +:10754000089508F595656E646974FF91EF911F9138 +:107550000F915F925F92099444F5D57264726F70D7 +:1075600027DD3CF50C946C3A5AF583733E6497FF23 +:10757000C1CCC9CC6AF587646E656761746549D012 +:107580000E9408320C94E63276F5883F646E656797 +:107590006174650023DD2ED909F0F1DF08958AF5C5 +:1075A0008464616273000DDD0C94CA3AA0F58264B4 +:1075B0002B00A991B991E991F99109911991A00F25 +:1075C000B11F8E1F9F1FBA93AA930895AEF58264D0 +:1075D0002D00D5DF0C94D93ACEF58364322F099172 +:1075E000199195958795179507951A930A9308957C +:1075F000DAF58364322A09911991000F111F881F4F +:10760000991F1A930A930895F2F58764696E766557 +:1076100072740991199100951095809590951A931F +:107620000A9308950AF68364303DA991B991892B94 +:107630008A2B8B2B51F48FEF9FEF089526F68364EE +:10764000303CA991B9919030B2F3882799270895D9 +:107650003EF682643D00BDDF0C94153B52F6826419 +:107660003C00B7DF0C94213B5EF682643E000E9432 +:10767000DC310C94313B6AF68375642E37D94FD9CF +:1076800057D90E944F320C94E53178F682642E006F +:107690002DD98F939F9387DF42D90E94C33253D94C +:1076A00047D90E944F320C94E5318CF6826869000C +:1076B0007FDCC0F60E9447310E94DE320C94863E89 +:1076C000FFDEFF0CFF08ACF6A24070009A938A938D +:1076D000CA010895C8F6837063409A938A93CA01D9 +:1076E0000C94A13ED6F6A370322B470D551D08957C +:1076F0000000866D61726B6572000E942C31ABDCFC +:1077000057DC00090E945131CDDBE0D9CBDB0E9470 +:1077100091320E943A31F1DC0E94E83083DDC2DB15 +:107720000C94663598DF856C6F61642B70610895E9 +:1077300026F7856C6F61642D7F7E25982D980895BE +:1077400000FE03C035DC50007FDC01FE03C030DCEE +:1077500045007ADC02FE03C02BDC420075DC03FE30 +:1077600003C026DC570070DC16FE03C021DC4D0090 +:107770006BDC0C94E53174FF02C0259A2D9876FFDE +:1077800007C003E0201621F401E003BF889553BE33 +:0677900074FD2D9A08951E +:067800000C94703D3BD02A +:0278080039D075 +:02780C0037D073 +:0278100035D071 +:0278140033D06F +:0278180031D06D +:02781C002FD06B +:027820002DD069 +:027824002BD067 +:0278280029D065 +:02782C0027D063 +:0278300025D061 +:0278340023D05F +:0278380033C05B +:02783C001FD05B +:027840001DD059 +:027844001BD057 +:0278480019D055 +:02784C0017D053 +:0278500015D051 +:0278540013D04F +:0278580011D04D +:02785C000FD04B +:027860000DD049 +:107864000BD09F918F911F910F91FF91EF91A9914F +:10787400B991BFBFB9911895BA93BFB7BA93AA93F8 +:10788400BF91AF91EF93FF930F931F938F939F93A8 +:10789400BFE7AB0FB1E0ED91FD910994BA93BFB787 +:1078A400BA93AA93E60CF51CE2CFE7EBF1E0A091C2 +:1078B400B401EA0FF51DB091C600BF3009F49ECFA4 +:1078C400B083A395AF71A093B401A091B601A39521 +:1078D400A093B601AE3109F404D0A4300AF021D04B +:1078E400C0CFFCE720C032F783747830813161F077 +:1078F400833191F0A0D20091C00005FFFBCF8093AB +:10790400C6008991999108958991999102C070FF57 +:1079140008957E7FF1E107C08991999102C070FDBD +:1079240008957160F3E1E091C000E5FFFCCFF093AE +:10793400C6000895ECF8837278307DD21ED00E9480 +:10794400FA33D9F39A938A93E7EBF1E0A091B50166 +:10795400EA0FF51D808199270FB7F894A395AF71AD +:10796400A093B501A091B601AA95A093B6010FBF4B +:1079740008953AF9847278303F00A091B601A511B8 +:107984000C948337C4DF0C947A37BEDC0E945C32DB +:107994000341443F0E944F32E2CA90588093E3016E +:1079A4009093E4019F3588F70091E30100780A1170 +:1079B40005C00091E4010B1101C0089575D0009138 +:1079C400E3010078A02EB090E40100E8F501A0E006 +:1079D400B1E015911D930A95E1F70895E7DA1300D4 +:1079E4000E948B30E3DA0A002DDCF894F50113E0F1 +:1079F4002DD011E12BD000E8A0E0B1E00F921F924E +:107A04000D901D9011E022D032960250C9F7E05833 +:107A1400F04015E01BD014D000E8A058B040059009 +:107A24001D9001105BC00150D1F71F900F900FEF14 +:107A3400B02E6E7F7894BADA11000E948B300895CC +:107A440087B686FE089511E101D0FACF87B680FC8F +:107A5400FDCF17BFE895089534FE8377642BF8941F +:107A6400A8959091600098619093600087708860F9 +:107A74008093600078940C9498325EFA8377642D36 +:107A8400F894A89554BE08E10093600050926000F9 +:107A94007894089580FAA3637764A89508959AFA70 +:107AA4008669666C7573680060FD98CF089578F9EF +:107AB40085656D7074797ADA40FF78DA000976DAD0 +:107AC4000C000E9466350C9456375524E1E0F2E030 +:107AD4003F010895B4FA847761726D00F894AA277F +:107AE400BB27C9E1D0E0DD93C150E9F71FB604B666 +:107AF40050923400ACE15D92B031E9F7BA94C1EA36 +:107B0400D2E004E412E00DBF1EBFDFDF0E94423D5D +:107B140003E012E018014ADA22DF48DAE50146DA26 +:107B24001C000E94663542DA0009EED0EAD90E94B0 +:107B34008B330E94FA3309F0BEDF65BE75BE74BC98 +:107B440003E005BD09EF07BD70926E002FDA573CC4 +:107B54002DDAA4019FD007E60093C40008E900933E +:107B6400C10006E00093C20071609ED97894E6DDFE +:107B740023D05AD10E94FA33D1F00E945C320345DB +:107B840053430E944F3212DAD0075CDB0E949830D4 +:107B94000E94FA3349F00E94913008DA1B000E94D7 +:107BA4008B330E94FA3319F43FD10E94A0300C9415 +:107BB400B137DAFA837665720E945C3223466C61CF +:107BC4007368466F72746820352041546D6567612F +:107BD4003332382032322E30332E323031370D0AE0 +:107BE4000C944F32B8FBA265690078940895EAFBBF +:107BF400A2646900F8940895F4FBC23B6900D6D9E5 +:107C04000C943AD1D3D9333C37D10C949838FEFB39 +:107C140084696E742100FC013197EE0FF0E8EF0FD8 +:107C2400F1E089919991C4DB0C94513E14FCC76C2A +:107C340069746572616CBAD9C2EF4CDC8093D70168 +:107C44009093D80160680E94E137982F92959F70B5 +:107C54008F70906E806810D1892F92959F708F706D +:107C6400906E80690C943E3F98DE89919991A0E0D2 +:107C7400B1E00091E3010F77A00F8D939D9374C041 +:107C840032FC823E6100282F392F89919991089501 +:107C940086FC8121993040F4FC018991999191836A +:107CA400808389919991089509D09038E8F60E94CB +:107CB400D5316BD001960981088367C062FF0895AE +:107CC40023DB0E945C320341443F0E944F326FCF5A +:107CD400FC01F058FB110BC00E2F00780A1539F483 +:107CE400A0E0B1E0EF77AE0F8D919D91089585915D +:107CF4009591089596FC82613E009A938A93822F0F +:107D0400932F0895FAFC8140993020F4FC0181916D +:107D1400919108959038E0F6F999FECF995081BD7C +:107D240092BDF89A00B5839581BDF89A90B5802FDD +:107D34000895CEDF992708950AFD826340009930A3 +:107D440020F4FC01819199270895903890F7E4DF9D +:107D54009927089522DE89919991A0E0B1E00091DC +:107D6400E3010F77A00F8D93616009C03EFD82632C +:107D74002100993038F4FC0189919991808389918B +:107D8400999108959BDF903828F7F999FECF99507F +:107D940081BD92BD8991999180BDFA9AF99AEFCFEC +:107DA40072FD83666C2D64600895A6FD83666C2B5A +:107DB4006B7F0895B0FD8576616C75654AD90E9424 +:107DC400563199D90E94E8300C94863EBAFD8564F8 +:107DD400656665723ED90E94D83762EF0E945631BB +:107DE4008AD90E94E8300C94AB30D2FDC26973008A +:107DF4000E94F4370E9459330E94593385DFF5D924 +:107E04000E94FA3329F017DF0E94F83098FC01C071 +:107E140041DF0895F0FDC2746F000C94FA3E1AFE1F +:107E2400877475726E6B65790E94E43ED90124FEF5 +:107E34008570617573659DDC1FB7F894A895DF9311 +:107E4400CF939F938F935F934F93F1010EB7029358 +:107E54000DB70293B291A2911D010E910EBF0E9126 +:107E64000DBF4F915F918F919F91CF91DF911FBF74 +:107E7400089570DF82692C000E940E380BDF0E9487 +:107E840067310C94C73978FE8369632C0E940E38DD +:107E940070DF0E9408320C94C73981200E940D358E +:107EA40033DF803111F484E209C08A3011F483E2B3 +:107EB40005C0823011F485E201C08FE3089552E2D7 +:107EC40060E270E20F921F9209911991809FD00194 +:107ED400EE27FF27909FB00DE11DF51D819FB00D8A +:107EE400E11DF51D919FE00DF11DBA93AA93CF01F9 +:107EF4001F900F900895E894882329F4992319F486 +:107F040068940C94703DDC011990E99189919991E0 +:107F140000E1FF27880F991F111CEE1FFF1F1A167F +:107F2400EB07F50518F083951A1AEB0B0A9589F7F8 +:107F3400EA931A920895B0E9BEE9CEE90000008000 +:087F44000C09FF02F2F67AEECF +:00000001FF diff --git a/forth/flash-led.fs b/forth/flash-led.fs new file mode 100644 index 0000000..08fc643 --- /dev/null +++ b/forth/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/main.fs b/forth/main.fs new file mode 100644 index 0000000..bfbf81e --- /dev/null +++ b/forth/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/rand.fs b/forth/rand.fs new file mode 100644 index 0000000..2bd2447 --- /dev/null +++ b/forth/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/uno.fs b/forth/uno.fs new file mode 100644 index 0000000..bd70aa3 --- /dev/null +++ b/forth/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 -- cgit v1.2.3 From 55aa48a0137694efcf11ed66070690589596d2aa Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:01:34 +0200 Subject: add shell --- forth/ff-shell.tcl | 345 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 345 insertions(+) create mode 100755 forth/ff-shell.tcl diff --git a/forth/ff-shell.tcl b/forth/ff-shell.tcl new file mode 100755 index 0000000..4fd1ae3 --- /dev/null +++ b/forth/ff-shell.tcl @@ -0,0 +1,345 @@ +#!/usr/bin/env wish +# ff-shell.tcl +# The Manual +# ---------- +# This simple shell is built around the Tcl/Tk text widget. +# Using a custom binding, key presses sent to the widget +# are redirected to the serial port and the FlashForth micro +# attached to that port. Incoming characters from the micro +# are received from the serial port and are inserted into the +# widget at the end of the text. An update to the GUI is +# triggered at the end of every line. +# +# A file is sent to the serial port, one line at a time. +# To allow the GUI to update smoothly in this single-threaded +# program, the lines to send are accumulated into a list and a +# procedure to send the first line is scheduled. +# For each line to be sent, the procedure checks if it is +# still waiting for a carriage-return from the microcontroller. +# If it is, the work of sending the line is rescheduled for +# a later time. If it is not waiting, the line is sent +# one character at a time. Incoming characters are inserted +# at the end of the text widget as they arrive. +# +# Copy-and-Paste insertions to the text widget are intercepted +# by the <> binding and handled in a similar manner +# as sending lines from a file. +# +# At any point in time, the text from the widget may be saved +# to a file. This might be good a way to save a session or +# collect large amounts of output from the microcontroller. +# +# You will need to run with sufficient privilege to access +# the serial port. +# On Ubuntu, this can be done by starting the program like so: +# $ sudo ./ff-shell.tcl +# +# Author +# ------ +# P.A.Jacobs +# School of Engineering, Uni of Qld. +# +# Version +# ------- +# 2015-04-03 +# Initial code cobbled together from a few examples, especially +# Rolf Schroedter's simple terminal at http://wiki.tcl.tk/3642 +# and Mikael Nordman's ff-shell.py. +# 2015-04-25, 26 +# Added status line and selection of speed, etc, from the GUI. +# +# Licence +# ------- +# GPL, as per the rest of FlashForth. +# +# -------------------------------------------------------------- +# Configuration +# Set defaults that suit your environment. + +set ::baudRate 9600; # 38400 +set ::parity "n"; # n=none e=even o=odd m=mark s=space +set ::dataBits 8; # 7 8 +set ::stopBits 1; # 1 2 +set ::parityAndBits "$::parity,$::dataBits,$::stopBits" +set ::handShake xonxoff; # none xonxoff rtscts +if { [string equal $::tcl_platform(platform) windows] } { + console show + set ::serialPortName {\\.\com5} +} else { + set ::serialPortName "/dev/ttyACM0" +}; # end if +set ::portState closed + +set ::textWidth 80 +set ::textHeight 24 +set ::textFont Courier + +set ::afterLineMilliseconds 20 + +# -------------------------------------------------------------- +# Sending and receiving characters, one at a time. + +set ::waitingForCR false + +proc serialIn { channel } { + if { [chan eof $channel] } { + puts "Oops serial channel read: eof" + closeSerialPort + return + } + if { [catch {chan read $channel 1} character] } { + puts "Oops serial channel read: $character" + return + } + if { [string length $character] == 0 } { + return + } + switch -regexp -- $character { + \x07 { bell } + \x08 { deleteLastChar } + \x09 { addToLogText $character } + \x0a { } + \x0d { addToLogText "\n"; set ::waitingForCR false; showLogTail; update } + \x11 { puts -nonewline Xon } + \x13 { puts -nonewline Xoff } + [\x20-\x7e] { addToLogText $character } + }; # end switch +}; # end serialIn + +proc serialOut { channel character } { + # puts -nonewline $channel $character; flush $channel + # send CR and BS through but not LF + switch -regexp -- $character { + \x0a {} + \x08 - + \x09 - + \x0d - + \x0f - + [\x20-\x7e] { puts -nonewline $channel $character; flush $channel } + }; # end switch +}; # end serialOut + +proc openSerialPort {} { + if { [catch {open $::serialPortName r+} result] } { + puts "openSerialPort: $result" + set ::portState closed + } else { + set ::tty $result + puts "Serial channel is open as $::tty" + # We allow a short timeout period to prevent the read function + # from stalling for too long. + chan configure $::tty -mode $::baudRate,$::parityAndBits -timeout 10 \ + -encoding binary -translation binary -handshake $::handShake \ + -buffering none -buffersize 8192 -blocking false + if { [string equal $::tcl_platform(platform) windows] } { + chan configure $::tty -sysbuffer 8192 + } + chan event $::tty readable [list serialIn $::tty] + set ::portState open + } +}; # end openSerialPort + +proc closeSerialPort {} { + if { [catch {close $::tty} err] } { + puts "Close serial port failed: $err" + } + set ::portState closed +}; # end closeSerialPort + +# -------------------------------------------------------------- +# GUI elements +wm title . "FlashForth Shell" +# Main menu allow us a convenient way to exit. +menu .mb +. configure -menu .mb +menu .mb.file -tearoff 0 +.mb.file add command -label "Send..." -command { sendFile } +.mb.file add command -label "Exit" -command { displayExitDialog } +.mb add cascade -label File -menu .mb.file +menu .mb.log -tearoff 0 +.mb.log add command -label "Clear" -command { clearLogText } +.mb.log add command -label "Save..." -command { saveLogText } +.mb add cascade -label Log -menu .mb.log +menu .mb.micro -tearoff 0 +.mb.micro add command -label "Warm restart" -command { warmRestart } +.mb add cascade -label Micro -menu .mb.micro +menu .mb.help -tearoff 0 +.mb.help add command -label "About..." -command { displayAboutMessage } +.mb.help add command -label "Hints" -command { displayHints } +.mb add cascade -label Help -menu .mb.help + +proc displayExitDialog {} { + if [tk_messageBox -type yesno -icon question -message "Really exit?"] { + closeSerialPort + exit + } +} + +proc displayAboutMessage {} { + tk_messageBox -type ok -icon info -parent . \ + -message "ff-shell in Tcl\nA simple shell for FlashForth.\n2015-05-01" +} + +proc displayHints {} { + set message { + "\n----------------------------------------------------------" + "\nType directly into the text window. Characters will go to" + "\nthe microcontroller, one at a time. Incoming characters" + "\nfrom the microcontroller will appear in the text window." + "\n" + "\nSending a file: For every line of the file, characters go" + "\none at a time to the microcontroller, but the shell will" + "\nwait for a carriage-return from the microcontroller before" + "\nsending the next line." + "\n" + "\nPasting a selection of text works in a similar way to" + "\nsending a file. You should be able to paste large sections" + "\nof text without overruns." + "\n" + "\nKeyboard short-cuts:" + "\nControl-Shift-v send selection to micro" + "\nControl-Shift-s save log" + "\nControl-Shift-x exit" + "\nControl-Shift-o warm restart of micro" + "\n----------------------------------------------------------" + "\n" + } + foreach line $message { addToLogText $line } +} + +# A scrolling text window to log messages +set textFrame [ttk::frame .tf] +set ::logText [text .tf.t -height $::textHeight -width $::textWidth \ + -font $::textFont -wrap char \ + -yscrollcommand [list $textFrame.vsb set] ] +set textScrollBar [ttk::scrollbar .tf.vsb -orient vertical \ + -command {$::logText yview} ] +pack $::logText -side left -expand 1 -fill both +pack $textScrollBar -side left -fill y +pack $textFrame -fill both -expand 1 + +# A status line +set statusFrame [ttk::labelframe .sf -text "Serial Port"] +set lab1 [ttk::label .sf.lab1 -text "Device:"] +set deviceEntry [ttk::entry .sf.entr1 -width 15 -textvariable ::serialPortName] +pack $lab1 $deviceEntry -side left +set lab2 [ttk::label .sf.lab2 -text "Speed:"] +set speedEntry [ttk::entry .sf.entr2 -width 8 -textvariable ::baudRate] +pack $lab2 $speedEntry -side left +set lab3 [ttk::label .sf.lab3 -text "ParityAndBits:"] +set entr3 [ttk::entry .sf.entr3 -width 6 -textvariable ::parityAndBits -state readonly] +pack $lab3 $entr3 -side left +set lab4 [ttk::label .sf.lab4 -text "Hand Shake:"] +set entr4 [ttk::entry .sf.entr4 -width 7 -textvariable ::handShake -state readonly] +pack $lab4 $entr4 -side left +set lab5 [ttk::label .sf.lab5 -text "State:"] +set entr5 [ttk::entry .sf.entr5 -width 6 -textvariable ::portState -state readonly] +pack $lab5 $entr5 -side left +pack $statusFrame -fill x -expand 0 + +bind $deviceEntry { closeSerialPort; openSerialPort } +bind $speedEntry { closeSerialPort; openSerialPort } + +proc addToLogText { txt } { + $::logText insert end "$txt" +} + +proc showLogTail {} { + $::logText yview moveto 1.0 +} + +proc deleteLastChar {} { + $::logText delete "end-2c" + $::logText yview moveto 1.0 +} + +proc clearLogText {} { + $::logText delete 1.0 end +} + +set ::saveFileName {} + +proc saveLogText {} { + set ::saveFileName [tk_getSaveFile -initialfile $::saveFileName \ + -title "Save log text to file"] + if {[string length $::saveFileName] > 0} { + set fp [open $::saveFileName "w"] + puts $fp [$::logText get 1.0 end] + close $fp + } +}; # end saveLogText + +proc sendTextChar { character } { + # We use this function in the key-binding for the logText widget. + # The break is to stop the default binding from inserting another + # character into the widget. + serialOut $::tty $character + return -code break +} + +set ::linesToSend {} + +proc sendFirstLine {} { + if {$::waitingForCR} { + # reschedule the current work + after $::afterLineMilliseconds sendFirstLine + return + } + # Pop the first line from the list and send it. + set line [lindex $::linesToSend 0] + set ::linesToSend [lreplace $::linesToSend 0 0] + foreach character [split $line {}] { + serialOut $::tty $character + after 1; # 1ms pause after each character + } + serialOut $::tty "\r" + set ::waitingForCR true + if {[llength $::linesToSend] > 0} { + # there is more work to do + after $::afterLineMilliseconds sendFirstLine + } +}; # end sendLine + +set ::sendFileName {} + +proc sendFile {} { + set ::sendFileName [tk_getOpenFile -initialfile $::sendFileName \ + -title "Open file to send"] + if {[string length $::sendFileName] > 0} { + set fp [open $::sendFileName "r"] + while {[gets $fp line] >= 0} { lappend ::linesToSend $line } + close $fp + sendFirstLine + } +}; # end sendFile + +proc sendSelection { text } { + foreach line [split $text "\n"] { lappend ::linesToSend $line } + sendFirstLine + return -code break +}; # end sendSelection + +# The following binding redirects key presses in the text widget +# to the serial-port. +bind $::logText [list sendTextChar %A] + +# The following virtual event can be triggered with Control-Shift-v +# or with clicking the middle mouse button in X-Windows. +# The selected region of text is sent to the serial port. +event add <> +bind $::logText <> { sendSelection [selection get] } + +# Keyboard short-cuts. +bind $::logText { sendFile } +bind $::logText { saveLogText } +bind $::logText { displayExitDialog } + +proc warmRestart {} { + serialOut $::tty "\x0f"; # Control-O +} + +# -------------------------------------------------------------- +# Initialize streams and hand control over to the event loop. +openSerialPort +update idletasks +focus $::logText -- cgit v1.2.3 From a7ac30a16cb4e2338ded87235deb352c1055da16 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:44:31 +0200 Subject: add core.fs --- forth/core.fs | 450 +++++++++++++++++++++++++++++++++++++++++++++++++++++ forth/ff-shell.tcl | 10 +- 2 files changed, 453 insertions(+), 7 deletions(-) create mode 100644 forth/core.fs diff --git a/forth/core.fs b/forth/core.fs new file mode 100644 index 0000000..511288d --- /dev/null +++ b/forth/core.fs @@ -0,0 +1,450 @@ +\ 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@+ ; + +\ 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" +; + +\ xu ... x0 u -- xu ... x0 xu +: pick 2* sp@ + @ ; + +-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 + +-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 + +-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 [ +; + +-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! +; + +-io +marker -io + +\ 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 + +-main +marker -main diff --git a/forth/ff-shell.tcl b/forth/ff-shell.tcl index 4fd1ae3..1aca0cb 100755 --- a/forth/ff-shell.tcl +++ b/forth/ff-shell.tcl @@ -62,11 +62,10 @@ set ::dataBits 8; # 7 8 set ::stopBits 1; # 1 2 set ::parityAndBits "$::parity,$::dataBits,$::stopBits" set ::handShake xonxoff; # none xonxoff rtscts -if { [string equal $::tcl_platform(platform) windows] } { - console show - set ::serialPortName {\\.\com5} -} else { +if { [string equal $::tcl_platform(os) Linux] } { set ::serialPortName "/dev/ttyACM0" +} else { + set ::serialPortName "/dev/cuaU0" }; # end if set ::portState closed @@ -131,9 +130,6 @@ proc openSerialPort {} { chan configure $::tty -mode $::baudRate,$::parityAndBits -timeout 10 \ -encoding binary -translation binary -handshake $::handShake \ -buffering none -buffersize 8192 -blocking false - if { [string equal $::tcl_platform(platform) windows] } { - chan configure $::tty -sysbuffer 8192 - } chan event $::tty readable [list serialIn $::tty] set ::portState open } -- cgit v1.2.3 From 110a6411bae421260476eacf6173897c1d1f4b8a Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:50:57 +0200 Subject: ... --- forth/core.fs | 19 ------------------- forth/main.fs | 36 ++---------------------------------- 2 files changed, 2 insertions(+), 53 deletions(-) diff --git a/forth/core.fs b/forth/core.fs index 511288d..1682aa6 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -427,24 +427,5 @@ $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 - -main marker -main diff --git a/forth/main.fs b/forth/main.fs index bfbf81e..fbb279e 100644 --- a/forth/main.fs +++ b/forth/main.fs @@ -1,34 +1,2 @@ --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= ; +-main +marker -main -- cgit v1.2.3