aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--forth/elegoo/depth.fs4
-rw-r--r--forth/elegoo/elegoo.fs23
-rw-r--r--forth/elegoo/fib.fs5
-rw-r--r--forth/elegoo/flash-led.fs (renamed from forth/flash-led.fs)0
-rw-r--r--forth/elegoo/main.fs (renamed from forth/main.fs)0
-rw-r--r--forth/elegoo/rand.fs17
-rw-r--r--forth/elegoo/uno.fs138
-rw-r--r--forth/forth/2literal.fs14
-rw-r--r--forth/forth/avr/asm-examples.fs36
-rw-r--r--forth/forth/avr/asm.fs281
-rw-r--r--forth/forth/avr/asm2.fs192
-rw-r--r--forth/forth/avr/asm2test.fs32
-rw-r--r--forth/forth/avr/asmtest.fs59
-rw-r--r--forth/forth/avr/bit-test.fs58
-rw-r--r--forth/forth/avr/bit.fs77
-rw-r--r--forth/forth/avr/doloop.fs92
-rw-r--r--forth/forth/avr/i2c-base-avr.fs99
-rw-r--r--forth/forth/avr/i2c-ds1307.fs72
-rw-r--r--forth/forth/avr/irqAtmega128.fs45
-rw-r--r--forth/forth/avr/irqAtmega2560.fs45
-rw-r--r--forth/forth/avr/irqAtmega328.fs42
-rw-r--r--forth/forth/avr/pick.fs6
-rw-r--r--forth/forth/avr/see.fs (renamed from forth/see.fs)0
-rw-r--r--forth/forth/avr/task-test-arduino-mega2560.fs48
-rw-r--r--forth/forth/avr/task-test-arduino-uno.fs45
-rw-r--r--forth/forth/avr/task-test.fs45
-rw-r--r--forth/forth/avr/task.fs160
-rw-r--r--forth/forth/avr/task2-test.fs47
-rw-r--r--forth/forth/avr/us.fs37
-rw-r--r--forth/forth/avr/xdump.fs45
-rw-r--r--forth/forth/case-test.fs23
-rw-r--r--forth/forth/case.fs52
-rw-r--r--forth/forth/core.fs49
-rw-r--r--forth/forth/ct-test.fs22
-rw-r--r--forth/forth/ct.fs40
-rw-r--r--forth/forth/doloop-test.fs32
-rw-r--r--forth/forth/dump.fs26
-rw-r--r--forth/forth/forget.fs18
-rw-r--r--forth/forth/free.fs25
-rw-r--r--forth/forth/help.fs68
-rw-r--r--forth/forth/helpwords.fs255
-rw-r--r--forth/forth/i2c-detect.fs54
-rw-r--r--forth/forth/jmptbl-test.fs70
-rw-r--r--forth/forth/jmptbl.fs76
-rw-r--r--forth/forth/jt-test.fs9
-rw-r--r--forth/forth/jt.fs42
-rw-r--r--forth/forth/math.fs79
-rw-r--r--forth/forth/sieve.fs43
-rw-r--r--forth/forth/sieve2.fs59
-rw-r--r--forth/forth/tc74-app.fs40
-rw-r--r--forth/forth/vt100-test.fs36
-rw-r--r--forth/forth/vt100.fs55
52 files changed, 2937 insertions, 0 deletions
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/flash-led.fs b/forth/elegoo/flash-led.fs
index 08fc643..08fc643 100644
--- a/forth/flash-led.fs
+++ b/forth/elegoo/flash-led.fs
diff --git a/forth/main.fs b/forth/elegoo/main.fs
index bfbf81e..bfbf81e 100644
--- a/forth/main.fs
+++ b/forth/elegoo/main.fs
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/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/see.fs b/forth/forth/avr/see.fs
index a1c2deb..a1c2deb 100644
--- a/forth/see.fs
+++ b/forth/forth/avr/see.fs
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. 0<n<256
+u/ u1 u2 -- u3 Unsigned 16/16->16 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 ;
+