From 2f83a0bea9da444e3d70569eba3d6847ca02be03 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 21:59:17 +0200 Subject: ... --- forth/forth/avr/asm-examples.fs | 36 ++++ forth/forth/avr/asm.fs | 281 ++++++++++++++++++++++++++ forth/forth/avr/asm2.fs | 192 ++++++++++++++++++ forth/forth/avr/asm2test.fs | 32 +++ forth/forth/avr/asmtest.fs | 59 ++++++ forth/forth/avr/bit-test.fs | 58 ++++++ forth/forth/avr/bit.fs | 77 +++++++ forth/forth/avr/doloop.fs | 92 +++++++++ forth/forth/avr/i2c-base-avr.fs | 99 +++++++++ forth/forth/avr/i2c-ds1307.fs | 72 +++++++ forth/forth/avr/irqAtmega128.fs | 45 +++++ forth/forth/avr/irqAtmega2560.fs | 45 +++++ forth/forth/avr/irqAtmega328.fs | 42 ++++ forth/forth/avr/pick.fs | 6 + forth/forth/avr/see.fs | 77 +++++++ forth/forth/avr/task-test-arduino-mega2560.fs | 48 +++++ forth/forth/avr/task-test-arduino-uno.fs | 45 +++++ forth/forth/avr/task-test.fs | 45 +++++ forth/forth/avr/task.fs | 160 +++++++++++++++ forth/forth/avr/task2-test.fs | 47 +++++ forth/forth/avr/us.fs | 37 ++++ forth/forth/avr/xdump.fs | 45 +++++ 22 files changed, 1640 insertions(+) create mode 100644 forth/forth/avr/asm-examples.fs create mode 100644 forth/forth/avr/asm.fs create mode 100644 forth/forth/avr/asm2.fs create mode 100644 forth/forth/avr/asm2test.fs create mode 100644 forth/forth/avr/asmtest.fs create mode 100644 forth/forth/avr/bit-test.fs create mode 100644 forth/forth/avr/bit.fs create mode 100644 forth/forth/avr/doloop.fs create mode 100644 forth/forth/avr/i2c-base-avr.fs create mode 100644 forth/forth/avr/i2c-ds1307.fs create mode 100644 forth/forth/avr/irqAtmega128.fs create mode 100644 forth/forth/avr/irqAtmega2560.fs create mode 100644 forth/forth/avr/irqAtmega328.fs create mode 100644 forth/forth/avr/pick.fs create mode 100644 forth/forth/avr/see.fs create mode 100644 forth/forth/avr/task-test-arduino-mega2560.fs create mode 100644 forth/forth/avr/task-test-arduino-uno.fs create mode 100644 forth/forth/avr/task-test.fs create mode 100644 forth/forth/avr/task.fs create mode 100644 forth/forth/avr/task2-test.fs create mode 100644 forth/forth/avr/us.fs create mode 100644 forth/forth/avr/xdump.fs (limited to 'forth/forth/avr') 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 ; + -- cgit v1.2.3