aboutsummaryrefslogtreecommitdiff
path: root/forth/forth/avr
diff options
context:
space:
mode:
Diffstat (limited to 'forth/forth/avr')
-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.fs77
-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
22 files changed, 1640 insertions, 0 deletions
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 ;
+