aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/lib
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/avr8/lib')
-rw-r--r--amforth-6.5/avr8/lib/2evalue.frt30
-rw-r--r--amforth-6.5/avr8/lib/assembler-test.frt58
-rw-r--r--amforth-6.5/avr8/lib/assembler.frt325
-rw-r--r--amforth-6.5/avr8/lib/bitnames-code.frt351
-rw-r--r--amforth-6.5/avr8/lib/bitnames.frt155
-rw-r--r--amforth-6.5/avr8/lib/calc-baudrate.frt12
-rw-r--r--amforth-6.5/avr8/lib/dot-res.frt19
-rw-r--r--amforth-6.5/avr8/lib/eallot.frt5
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core-ext.frt13
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt20
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt18
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt23
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core.frt26
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/align.frt3
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/aligned.frt3
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/avr-values.frt11
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/c-comma.frt3
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt15
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/environment-q.frt53
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/evaluate.frt46
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt22
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt8
-rw-r--r--amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt4
-rw-r--r--amforth-6.5/avr8/lib/hardware/25xxx.frt131
-rw-r--r--amforth-6.5/avr8/lib/hardware/flash-block.frt37
-rw-r--r--amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt136
-rw-r--r--amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt89
-rw-r--r--amforth-6.5/avr8/lib/hardware/int-q.frt2
-rw-r--r--amforth-6.5/avr8/lib/hardware/interrupts.frt7
-rw-r--r--amforth-6.5/avr8/lib/hardware/key2char.frt135
-rw-r--r--amforth-6.5/avr8/lib/hardware/keyboard.frt486
-rw-r--r--amforth-6.5/avr8/lib/hardware/mmc.frt371
-rw-r--r--amforth-6.5/avr8/lib/hardware/mpc485.frt156
-rw-r--r--amforth-6.5/avr8/lib/hardware/spi.frt110
-rw-r--r--amforth-6.5/avr8/lib/hardware/timer0.frt43
-rw-r--r--amforth-6.5/avr8/lib/hardware/timer1.frt44
-rw-r--r--amforth-6.5/avr8/lib/hardware/timer2.frt42
-rw-r--r--amforth-6.5/avr8/lib/imove.frt12
-rw-r--r--amforth-6.5/avr8/lib/portio.frt46
-rw-r--r--amforth-6.5/avr8/lib/ram.frt225
-rw-r--r--amforth-6.5/avr8/lib/recognizer-arch.frt8
-rw-r--r--amforth-6.5/avr8/lib/run-hayes.frt28
42 files changed, 3331 insertions, 0 deletions
diff --git a/amforth-6.5/avr8/lib/2evalue.frt b/amforth-6.5/avr8/lib/2evalue.frt
new file mode 100644
index 0000000..6a1d3aa
--- /dev/null
+++ b/amforth-6.5/avr8/lib/2evalue.frt
@@ -0,0 +1,30 @@
+\ use 2 cells of EEPROM
+\ Author: Erich Wälde
+\ Date: oct 2015
+
+\ #require quotations.frt
+\ #require eallot.frt
+
+: 2@e ( eaddr -- n2 n1 )
+ dup \ -- addr addr
+ cell+ \ -- addr addr+2
+ @e \ -- addr n2
+ swap \ -- n2 addr
+ @e \ -- n2 n1
+;
+: 2!e ( n1 n2 eaddr -- )
+ rot \ -- n2 eaddr n1
+ over \ -- n2 eaddr n1 eaddr
+ cell+ \ -- n2 eaddr n1 eaddr+2
+ !e \ -- n2 eaddr
+ !e \ --
+;
+
+: 2Evalue ( d -- )
+ (value)
+ ehere ,
+ [: @i 2@e ;] ,
+ [: @i 2!e ;] ,
+ ehere 2!e 2 cells eallot
+;
+
diff --git a/amforth-6.5/avr8/lib/assembler-test.frt b/amforth-6.5/avr8/lib/assembler-test.frt
new file mode 100644
index 0000000..b769f3d
--- /dev/null
+++ b/amforth-6.5/avr8/lib/assembler-test.frt
@@ -0,0 +1,58 @@
+\ ----- Test AvrAsm -----
+
+only forth also assembler
+
+: loadtos, 24 Y+ ld, 25 Y+ ld, ; \ define macro
+: savetos, -Y 25 st, -Y 24 st, ; \ from macros.asm
+
+code dup_ savetos, end-code \ insert asm code
+code drop_ loadtos, end-code
+
+code ++_ \ ( x1 x2 x3 -- x4 )
+ R14 2 ldi, \ + +
+ label>
+ R16 Y+ ld,
+ R17 Y+ ld,
+ R24 R16 add,
+ R25 R17 adc,
+ R14 1 subi,
+ <radr brne,
+end-code
+
+previous
+
+\ code demojmp \ demo jump + dup
+\ adr> 0 jmp, \ -+
+\ label> \ | +>-+
+\ clc, \ | | |
+\ adr> rjmp, \ | | +-+
+\ nop, \ | | |
+\ <labelr \ | | +<+
+\ adr> brcc, \ | | +-+
+\ nop, \ | | |
+\ rot <labell \ +> | |
+\ swap <radr rjmp, \ '-+ |
+\ <labelb \ <-+
+\ savetos,
+\ end-code
+
+\ code demojmp \ version with vector
+\ adr> 0 jmp, 0 >lbl \ addr->lbl[0]
+\ label> 1 >lbl
+\ clc,
+\ adr> rjmp, 2 >lbl
+\ nop,
+\ 2 <lbl <labelr
+\ adr> brcc, 3 >lbl
+\ nop,
+\ 0 <lbl <labell \ lbl[0]->tos
+\ 1 <lbl <radr rjmp,
+\ 3 <lbl <labelb
+\ savetos,
+\ end-code
+
+
+2 3 4 ++_ . \ 9
+5 6 drop_ dup_ . . \ 5 5
+
+\ end of file
diff --git a/amforth-6.5/avr8/lib/assembler.frt b/amforth-6.5/avr8/lib/assembler.frt
new file mode 100644
index 0000000..d8ed6b5
--- /dev/null
+++ b/amforth-6.5/avr8/lib/assembler.frt
@@ -0,0 +1,325 @@
+\ AvrAsm - assembler Atmega chips, Lubos Pekny, www.forth.cz
+\ Library for amforth 3.0 mFC 1.0
+
+\ V.1.1v, 29.01.2009, add vocabulary only
+
+\ V.1.1, 15.05.2008, tested on atmega32, amforth 2.7
+\ - change reg tosl,tosh in Test AvrAsm (loadtos, savetos)
+\ - change <label to <labelr
+\ - vector of labels, 20 bytes in RAM, example
+
+\ V.1.0, 07.02.2008, tested on atmega168, amforth 2.6
+\ Size 3554B (opcode: 2980B, labels: 158B, constants Rx: 416B)
+
+hex
+
+vocabulary assembler
+only forth also assembler definitions \ vocabulary
+
+ \ Store src to dest thru mask, FF00 0551 0333 mask! u. FD11
+: mask! ( dest1 src mask -- dest2 )
+ rot over invert and rot rot and or ; \ dest1&!mask src&mask or
+
+
+ \ Operands Rd,Rr
+: Rd,Rr, ( Rd Rr opcode mask -- xxxz.xxrd.dddd.rrrr )
+ >r >r \ -- Rd Rr | -- mask opcode
+ 1F and dup 5 lshift or 20F and \ -- Rd r00000rrrr
+ swap 4 lshift 1F0 and \ -- rr 0ddddd0000
+ or r> r> mask! \ -- ddrr opcode mask mask!
+ dup FC07 and 9000 = if EFFF and then , ; \ if Z or Y then z=0
+
+
+ \ Operand Rd
+: Rd, ( Rd opcode mask -- xxxx.xxxd.dddd.xxxx )
+ >r >r \ -- Rd | -- mask opcode
+ 4 lshift 1F0 and \ -- 0ddddd0000
+ r> r> mask! , ; \ dd opcode mask mask! to flash
+
+
+ \ Operands Rd,constant 8bit
+: Rd,k, ( Rd k8 opcode mask -- xxxx.kkkk.dddd.kkkk )
+ >r >r \ -- Rd k8 | -- mask opcode
+ FF and dup 4 lshift or F0F and \ -- Rd kkkk0000kkkk
+ swap 4 lshift F0 and \ -- kk dddd0000
+ or r> 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 )
+ >r >r \ -- Rd Rr k6 | -- mask opcode
+ 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> r> mask! , ; \ kkddrr opcode mask mask! to flash
+
+
+ \ Operands Rw pair,constant 6bit
+: Rw,k, ( Rw k6 opcode mask -- xxxx.xxxx.kkww.kkkk )
+ >r >r \ -- Rw k6 | -- mask opcode
+ 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> r> mask! , ; \ kkww opcode mask mask! to flash
+
+
+ \ Operands P-port,bit
+: P,b, ( P b opcode mask -- xxxx.xxxx.PPPP.Pbbb )
+ >r >r \ -- P b | -- mask opcode
+ 7 and swap 3 lshift \ -- 0bbb PPPPP000
+ or r> r> mask! , ; \ PPbb opcode mask mask! to flash
+
+
+ \ Operands Rd,P-port
+: Rd,P, ( Rd P opcode mask -- xxxx.xPPd.dddd.PPPP )
+ >r >r \ -- Rd P | -- mask opcode
+ 3F and dup 5 lshift or 60F and \ -- Rd PP00000PPPP
+ swap 4 lshift 1F0 and \ -- PP 00ddddd0000
+ or r> r> mask! , ; \ ddPP opcode mask mask! to flash
+
+
+ \ Operand k16 k6
+: k22, ( k16 k6 opcode mask -- k16 xxxx.xxxk.kkkk.xxxk )
+ >r >r \ -- k16 k6 | -- mask opcode
+ dup 1 and swap 3 lshift \ -- 000k kkkkkk000
+ or r> r> mask! , , ; \ k16 kk opcode mask mask! to flash
+
+
+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
+
+
+: movw, 1 rshift swap \ R0:1,R2:3,R4:5,..R30:31
+ 1 rshift swap \ 0 2 movw, R0:1<--R2:3
+ 0100 FF00 Rd,Rr, ; ( Rd Rr -- )
+: mul, 9C00 FC00 Rd,Rr, ; \ 2 3 mul,
+: muls, 0200 FF00 Rd,Rr, ;
+: mulsu, 0300 FF88 Rd,Rr, ;
+: fmul, 0308 FF88 Rd,Rr, ;
+: fmuls, 0380 FF88 Rd,Rr, ;
+: fmulsu, 0388 FF88 Rd,Rr, ;
+: cpc, 0400 FC00 Rd,Rr, ;
+: sbc, 0800 FC00 Rd,Rr, ;
+: add, 0C00 FC00 Rd,Rr, ;
+: cpse, 1000 FC00 Rd,Rr, ;
+: cp, 1400 FC00 Rd,Rr, ;
+: sub, 1800 FC00 Rd,Rr, ;
+: adc, 1C00 FC00 Rd,Rr, ;
+: and, 2000 FC00 Rd,Rr, ;
+: eor, 2400 FC00 Rd,Rr, ;
+: or, 2800 FC00 Rd,Rr, ;
+: mov, 2C00 FC00 Rd,Rr, ; \ 2 3 mov, R2<--R3
+
+: cpi, 3000 F000 Rd,k, ; ( Rd k8 -- )
+: sbci, 4000 F000 Rd,k, ;
+: subi, 5000 F000 Rd,k, ;
+: ori, 6000 F000 Rd,k, ;
+: sbr, ori, ;
+: andi, 7000 F000 Rd,k, ;
+: cbr, invert andi, ;
+: ldi, E000 F000 Rd,k, ; \ 2 FF ldi, R2<--#FF
+
+: ldd, 8000 D200 Rd,Rr+q, ; ( Rd Rr q -- ) \ Rr={Z+,Y+}, 2 Y+ 3F ldd,
+: std, rot rot
+ 8200 D200 Rd,Rr+q, ; ( Rd q Rr -- ) \ Rd={Z+,Y+}, Y+ 3F 2 std,
+
+: ld, 9000 FE00 Rd,Rr, ; ( Rd Rr -- ) \ Rr={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z}
+: lds, swap
+ 9000 FE0F Rd, , ; ( Rd k16 -- )
+: lpm_, 9004 FE0E Rd,Rr, ; ( Rd Rr -- ) \ Rr={Z,Z+}, 2 Z+ lpm_
+: elpm_, 9006 FE0E Rd,Rr, ; ( Rd Rr -- ) \ Rr={Z,Z+}
+: st, swap
+ 9200 FE00 Rd,Rr, ; ( Rd Rr -- ) \ Rd={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z}
+: sts, 9200 FE0F Rd, , ; ( k16 Rd -- ) \ FFFF 2 sts, adr(FFFF)<--R2
+
+: lsl, dup add, ; ( Rd -- )
+: rol, dup adc, ;
+: tst, dup and, ;
+: clr, dup eor, ;
+: ser, FF ldi, ;
+
+: pop, 900F FE0F Rd, ; ( Rd -- ) \ 2 pop,
+: push, 920F FE0F Rd, ;
+: com, 9400 FE0F Rd, ;
+: neg, 9401 FE0F Rd, ;
+: swap, 9402 FE0F Rd, ;
+: inc, 9403 FE0F Rd, ;
+: asr, 9405 FE0F Rd, ;
+: lsr, 9406 FE0F Rd, ;
+: ror, 9407 FE0F Rd, ;
+: bset, 9408 FF8F Rd, ;
+: bclr, 9488 FF8F Rd, ;
+: dec, 940A FE0F Rd, ;
+
+: nop, 0000 , ; ( -- )
+: ret, 9508 , ;
+: reti, 9518 , ;
+: sleep, 9588 , ;
+: break, 9598 , ;
+: wdr, 95A8 , ;
+: lpm, 95C8 , ;
+: elpm, 95D8 , ;
+: spm, 95E8 , ;
+: espm, 95F8 , ;
+: ijmp, 9409 , ;
+: eijmp, 9419 , ;
+: icall, 9509 , ;
+: eicall, 9519 , ;
+
+: clc, 9488 , ;
+: clh, 94D8 , ;
+: cli, 94F8 , ;
+: cln, 94A8 , ;
+: cls, 94C8 , ;
+: clt, 94E8 , ;
+: clv, 94B8 , ;
+: clz, 9498 , ;
+: sec, 9408 , ;
+: seh, 9458 , ;
+: sei, 9478 , ;
+: sen, 9428 , ;
+: ses, 9448 , ;
+: set, 9468 , ;
+: sev, 9438 , ;
+: sez, 9418 , ;
+
+: adiw, 9600 FF00 Rw,k, ; ( Rw k6 -- ) \ 3 3F adiw, ZLH=ZLH+#3F
+: sbiw, 9700 FF00 Rw,k, ;
+: cbi, 9800 FF00 P,b, ; ( P b -- )
+: sbic, 9900 FF00 P,b, ;
+: sbi, 9A00 FF00 P,b, ;
+: sbis, 9B00 FF00 P,b, ;
+
+: in, B000 F800 Rd,P, ; ( Rd P -- )
+: out, swap
+ B800 F800 Rd,P, ; ( P Rr -- )
+
+: bld, F800 FE08 Rd,Rr, ; ( Rd b -- )
+: bst, FA00 FE08 Rd,Rr, ;
+: sbrc, FC00 FE08 Rd,Rr, ;
+: sbrs, FE00 FE08 Rd,Rr, ;
+
+: jmp, 940C FE0E k22, ; ( k16 k6 -- ) \ k6=0 for 16b addr
+: call, 940E FE0E k22, ;
+: rjmp, C000 F000 mask! , ; ( k12 -- )
+: rcall, D000 F000 mask! , ;
+
+: brbc, F400 FC00 P,b, ; ( k7 b -- )
+: brbs, F000 FC00 P,b, ;
+: brcc, 0 brbc, ; ( k7 )
+: brcs, 0 brbs, ;
+: brsh, 0 brbc, ;
+: brlo, 0 brbs, ;
+: brne, 1 brbc, ;
+: breq, 1 brbs, ;
+: brpl, 2 brbc, ;
+: brmi, 2 brbs, ;
+: brvc, 3 brbc, ;
+: brvs, 3 brbs, ;
+: brge, 4 brbc, ;
+: brlt, 4 brbs, ;
+: brhc, 5 brbc, ;
+: brhs, 5 brbs, ;
+: brtc, 6 brbc, ;
+: brts, 6 brbs, ;
+: brid, 7 brbc, ;
+: brie, 7 brbs, ;
+
+
+ \ Relative addr, for jump back, <radr brne
+: <radr ( adr -- k )
+ dp 1+ - ;
+
+
+ \ Label for jump back, label> ......... <radr brne,
+: label> ( -- adr ) \ label> ......... <radr rjmp,
+ dp ; \ label> ......... 0 jmp,
+
+
+ \ Addr, for jump forward, adr> brne, adr> 0 jmp,
+: adr> ( -- adr k )
+ dp 0 ;
+
+
+ \ Label for branch forward, adr> brne, ......... <labelb
+: <labelb ( adr -- )
+ dup 1+ dp swap -
+ 7F and 3 lshift \ -- adr k7
+ over @i or \ -- adr opcode
+ swap !i ; \ overwrite branch
+
+
+ \ Label for jump forward, adr> rjmp, ......... <labelr
+: <labelr ( adr -- )
+ dup 1+ dp swap -
+ 0FFF and \ -- adr k12
+ over @i or \ -- adr opcode
+ swap !i ; \ overwrite rjmp, rcall
+
+
+ \ Label for long jump forward, adr> 0 jmp, ......... <labell
+: <labell ( adr -- )
+ 1+ dp swap !i ; \ overwrite k16
+
+
+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
+
+variable (lbl) 12 allot \ RAM for 10 labels
+
+ \ store addr to vector of labels
+: >lbl ( addr c -- ) \ index c=0..9
+ 2* (lbl) + ! ;
+
+ \ read addr from vector of labels
+: <lbl ( c -- addr ) \ index c=0..9
+ 2* (lbl) + @ ;
+
+previous definitions
diff --git a/amforth-6.5/avr8/lib/bitnames-code.frt b/amforth-6.5/avr8/lib/bitnames-code.frt
new file mode 100644
index 0000000..897bae3
--- /dev/null
+++ b/amforth-6.5/avr8/lib/bitnames-code.frt
@@ -0,0 +1,351 @@
+\ V 1.3, 02.11.2007
+\ V 1.3a, 15.07.2009, assembler version, L.Pekny
+
+\ Code: Matthias Trute
+\ Text: M.Kalus
+
+\ A named port pin puts a bitmask on stack, wherin the set bit indicates which
+\ bit of the port register corresponds to the pin.
+\ And then puts the address of its port on stack too.
+
+\ Use it this way:
+\ PORTD 7 portpin: PD.7 ( define portD pin #7)
+\ PD.7 high ( turn portD pin #7 on, i.e. set it high-level)
+\ PD.7 low ( turn portD pin #7 off, i.e. set it low-level)
+\ PD.7 <ms> pulse ( turn portD pin #7 for <ms> high and low)
+\ the following words are for "real" IO pins only
+\ PD.7 pin_output ( set DDRD so that portD pin #7 is output)
+\ PD.7 pin_input ( set DDRD so that portD pin #7 is input)
+\ PD.7 pin_high? ( true if pinD pin #7 is high)
+\ PD.7 pin_low? ( true if pinD pin #7 is low)
+\
+\ multi bit operation
+\ PORTD F portpin PD.F ( define the lower nibble of port d )
+\ PD.F pin@ ( get the lower nibble bits )
+\ 5 PD.F pin! ( put the lower nibble bits, do not change the others )
+
+hex
+
+\ At compiletime:
+\ Store combination of portaddress and bit number in a cell and give it a name.
+\ At runtime:
+\ Get pinmask and portaddress on stack.
+: portpin: create ( C: "ccc" portadr n -- ) ( R: -- pinmask portadr )
+ 1 swap lshift
+ 8 lshift or , \ packed value
+ does> @i \ get packed value
+ dup 8 rshift swap ff and \
+;
+
+: bitmask: create ( C: "ccc" portadr n -- ) ( R: -- pinmask portadr )
+ 8 lshift or , \ packed value
+ does> @i \ get packed value
+ dup 8 rshift swap ff and \
+;
+
+
+\ Turn a port pin on, dont change the others.
+: high ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ or ( -- portadr new-value)
+ swap ( -- new-value portadr)
+ c!
+;
+
+\ Turn a port pin off, dont change the others.
+: low ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ invert and ( -- portadr new-value)
+ swap ( -- new-value port)
+ c!
+;
+
+\ pulse the pin
+: pulse ( pinmask portaddr time -- )
+ >r
+ over over high
+ r> 0 ?do 1ms loop
+ low
+;
+
+: is_low? ( pinmask portaddr -- f )
+ c@ invert and
+;
+
+: is_high? ( pinmask portaddr -- f )
+ c@ and
+;
+
+\ write the pins masked as output
+\ read the current value, mask all but
+\ the desired bits and set the new
+\ bits. write back the resulting byte
+: pin! ( c pinmask portaddr -- )
+ dup ( -- c pm pa pa )
+ >r
+ c@ ( -- c pm c' )
+ over invert and ( -- c pm c'' )
+ >r ( -- c pm )
+ and
+ r> ( -- c c'' )
+ or r>
+ c!
+;
+
+
+\ Only for PORTx bits,
+\ because address of DDRx is one less than address of PORTx.
+
+\ Set DDRx so its corresponding pin is output.
+: pin_output ( pinmask portadr -- )
+ 1- high
+;
+
+\ Set DDRx so its corresponding pin is input.
+: pin_input ( pinmask portadr -- )
+ 1- low
+;
+
+\ PINx is two less of PORTx
+: pin_high? ( pinmask portaddr -- f )
+ 1- 1- c@ and
+;
+
+: pin_low? ( pinmask portaddr -- f )
+ 1- 1- c@ invert and
+;
+
+\ read the pins masked as input
+: pin@ ( pinmask portaddr -- c )
+ 1- 1- c@ and
+;
+
+\ toggle the pin
+: toggle ( pinmask portaddr -- )
+ over over pin_high? if
+ low
+ else
+ high
+ then
+;
+
+
+\ ----- assembler version -----
+\ assembler library: loadtos, savetos, TOSL,TOSH, readflashcell
+
+\ macros definitions
+: loadtos, 16 Y+ ld, 17 Y+ ld, ; \ define macro
+: savetos, -Y 17 st, -Y 16 st, ; \ tosl=r22, tosh=r23
+: TOSL 16 ;
+: TOSH 17 ;
+
+ \ read flash cell to tos
+: readflashcell,
+ assembler
+ ZL lsl, \ addr in ZH:ZL
+ ZH rol,
+ TOSL Z+ lpm_,
+ TOSH Z+ lpm_, ; \ @i to tos
+
+\ ---------------------------------------------
+\ macros definitions
+
+ \ convert mask+addr to port+bit for cbi, sbi,
+: ma2pbi ( mask addr -- port bit )
+ 20 - swap log2 ;
+
+
+ \ set pin high
+: high, ( pinmask portadr -- )
+ assembler
+ R16 over lds, \ @portadr
+ R16 rot ori, \ or pinmask
+ R16 sts, ; \ c!
+
+
+ \ set pin low
+: low, ( pinmask portadr -- )
+ assembler
+ R16 over lds, \ @portadr
+ R16 rot invert andi, \ and not(pinmask)
+ R16 sts, ; \ c!
+
+
+ \ c@ and
+: is_high?, ( pinmask portadr -- f )
+ assembler
+ R16 swap lds, \ @portadr
+ R16 swap andi, \ c@ and m
+ savetos,
+ TOSL R16 mov,
+ TOSH clr, ;
+
+
+ \ c@ invert and
+: is_low?, ( pinmask portadr -- f )
+ assembler
+ R16 swap lds, \ @portadr
+ R16 com, \ invert
+ R16 swap andi, \ and m
+ savetos,
+ TOSL R16 mov,
+ TOSH clr, ;
+
+
+ \ 1- 1- c@ and
+: pin@, ( pinmask portadr -- c )
+ 1- 1- is_high?, ;
+
+\ macros are for high speed words
+\ pin,addr,mask is directly in asm instruction
+\ example for use macros
+\ PORTB 04 portpin: SPI_SS \ PB.4 - SPI select
+\ : setoutSS SPI_SS pin_output ;
+\ code setoutSS SPI_SS 1- high, end-code
+\ code setoutSS SPI_SS 1- ma2pbi sbi, end-code
+\ : +mmc SPI_SS low ; \ forth speed
+\ code +mmc SPI_SS low, end-code \ asm speed
+\ code +mmc SPI_SS ma2pbi cbi, end-code \ asm high speed
+\ code SPI_SS_clk
+\ SPI_SS low,
+\ SPI_SS high,
+\ end-code
+
+
+\ code definitions
+\ pin,addr,mask is read from tos
+
+code (portpin:) ( addr -- pinmask portadr )
+ ZL TOSL movw, \ tos->z, addr @i
+ readflashcell, \ TOSH pinmask, TOSL portadr
+ R16 TOSL mov, \ temp0
+ TOSL TOSH mov,
+ TOSH clr,
+ savetos, \ -- pinmask
+ TOSL R16 mov, \ -- pinmask portadr
+end-code
+
+: portpin: create ( C: "ccc" portadr n -- ) ( R: -- pinmask portadr )
+ 1 swap lshift
+ 8 lshift or , \ packed value
+ does> (portpin:) \ get packed value
+ \ @i dup 8 rshift swap ff and \ replaced by (portpin:)
+;
+
+
+code high ( pinmask portadr -- )
+ \ dup c@ rot or swap c! \ replaced by assembler
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ R16 TOSL or, \ or pinmask
+ Z R16 st, \ c!
+ loadtos, \ delete pinmask
+end-code
+
+
+code low ( pinmask portadr -- )
+ \ dup c@ rot invert and swap c! \ replaced by assembler
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ TOSL com, \ not(pinmask)
+ R16 TOSL and, \ and pinmask
+ Z R16 st, \ c!
+ loadtos, \ delete pinmask
+end-code
+
+
+: pin_output ( pinmask portadr -- )
+ 1- high ;
+
+
+: pin_input ( pinmask portadr -- )
+ 1- low ;
+
+
+code pin! ( c pinmask portadr -- )
+ \ (c and m) or (@port and not(m))
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ R17 TOSL mov, \ pinmask
+ TOSL com, \ not(pinmask)
+ R16 TOSL and, \ and pinmask
+ loadtos, \ delete pinmask
+ R17 TOSL and, \ m and c
+ R16 R17 or, \ () or ()
+ Z R16 st, \ c!
+ loadtos, \ delete c
+end-code
+
+
+code pin@ ( pinmask portadr -- c )
+ \ 1- 1- c@ and
+ ZL TOSL movw, \ tos->z
+ ZH:ZL 2 sbiw, \ 1- 1-
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ TOSL R16 and, \ and pinmask
+ TOSH clr,
+end-code
+
+
+code is_low? ( pinmask portaddr -- c )
+ \ c@ invert and
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ R16 com, \ invert
+ loadtos, \ delete portadr
+ TOSL R16 and, \ and pinmask
+ TOSH clr,
+end-code
+
+
+code is_high? ( pinmask portaddr -- c )
+ \ c@ and
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ TOSL R16 and, \ and pinmask
+ TOSH clr,
+end-code
+
+
+code pin_low? ( pinmask portadr -- c )
+ \ 1- 1- c@ invert and
+ ZL TOSL movw, \ tos->z
+ ZH:ZL 2 sbiw, \ 1- 1-
+ R16 Z ld, \ addr c@
+ R16 com, \ invert
+ loadtos, \ delete portadr
+ TOSL R16 and, \ and pinmask
+ TOSH clr,
+end-code
+
+
+code pin_high? ( pinmask portadr -- c )
+ \ 1- 1- c@ and
+ ZL TOSL movw, \ tos->z
+ ZH:ZL 2 sbiw, \ 1- 1-
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ TOSL R16 and, \ and pinmask
+ TOSH clr,
+end-code
+
+
+code toggle ( pinmask portaddr -- )
+ ZL TOSL movw, \ tos->z
+ R16 Z ld, \ addr c@
+ loadtos, \ delete portadr
+ R16 TOSL eor, \ xor pinmask
+ Z R16 st, \ c!
+ loadtos, \ delete pinmask
+end-code
+
+\ end of file
diff --git a/amforth-6.5/avr8/lib/bitnames.frt b/amforth-6.5/avr8/lib/bitnames.frt
new file mode 100644
index 0000000..fdda840
--- /dev/null
+++ b/amforth-6.5/avr8/lib/bitnames.frt
@@ -0,0 +1,155 @@
+\ Code: Matthias Trute
+\ Text: M.Kalus
+
+\ A named port pin puts a bitmask on stack, wherin the set bit indicates which
+\ bit of the port register corresponds to the pin.
+\ And then puts the address of its port on stack too.
+
+\ Use it this way:
+\ PORTD 7 portpin: PD.7 ( define portD pin #7)
+\ PD.7 high ( turn portD pin #7 on, i.e. set it high-level)
+\ PD.7 low ( turn portD pin #7 off, i.e. set it low-level)
+\ PD.7 <ms> pulse ( turn portD pin #7 for <ms> high and low)
+\ the following words are for "real" IO pins only
+\ PD.7 pin_output ( set DDRD so that portD pin #7 is output)
+\ PD.7 pin_input ( set DDRD so that portD pin #7 is input)
+\ PD.7 pin_high? ( true if pinD pin #7 is high)
+\ PD.7 pin_low? ( true if pinD pin #7 is low)
+\
+\ multi bit operation
+\ PORTD F bitmask: PD.F ( define the lower nibble of port d )
+\ PD.F pin@ ( get the lower nibble bits )
+\ 5 PD.F pin! ( put the lower nibble bits, do not change the others )
+
+\ #require builds.frt
+
+: bitmask: ( C: "ccc" portadr bmask -- ) ( R: -- pinmask portadr )
+ <builds
+ , ,
+ does>
+ dup @i swap i-cell+ @i
+;
+
+: portpin: ( C: "ccc" portadr n -- ) ( R: -- pinmask portadr )
+ 1 over 7 and lshift >r \ bit position
+ 3 rshift + \ byte address
+ r> bitmask: \ portaddr may have changed
+;
+
+
+
+\ Turn a port pin on, dont change the others.
+: high ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ or ( -- portadr new-value)
+ swap ( -- new-value portadr)
+ c!
+;
+
+\ Turn a port pin off, dont change the others.
+: low ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ invert and ( -- portadr new-value)
+ swap ( -- new-value port)
+ c!
+;
+
+
+\ synonym off low
+\ synonym on high
+
+\ pulse the pin
+: pulse ( pinmask portaddr time -- )
+ >r
+ 2dup high
+ r> 0 ?do 1ms loop
+ low
+;
+
+: is_low? ( pinmask portaddr -- f)
+ c@ and 0=
+;
+
+: is_high? ( pinmask portaddr -- f)
+ c@ over and =
+;
+
+: wait_low ( pinmask portaddr -- )
+ begin
+ 2dup is_low?
+ until 2drop
+;
+
+: wait_high_all ( pinmask portaddr -- )
+ begin
+ 2dup is_high?
+ until 2drop
+;
+
+\ write the pins masked as output
+\ read the current value, mask all but
+\ the desired bits and set the new
+\ bits. write back the resulting byte
+: pin! ( c pinmask portaddr -- )
+ dup ( -- c pm pa pa )
+ >r
+ c@ ( -- c pm c' )
+ over invert and ( -- c pm c'' )
+ >r ( -- c pm )
+ and
+ r> ( -- c c'' )
+ or r>
+ c!
+;
+
+
+\ Only for PORTx bits,
+\ because address of DDRx is one less than address of PORTx.
+
+\ Set DDRx so its corresponding pin is output.
+: pin_output ( pinmask portadr -- )
+ 1- high
+;
+
+\ Set DDRx so its corresponding pin is input.
+: pin_input ( pinmask portadr -- )
+ 1- low
+;
+
+\ PINx is two less of PORTx
+: pin_high? ( pinmask portaddr -- f)
+ 1- 1- c@ and
+;
+
+: pin_low? ( pinmask portaddr -- f)
+ 1- 1- c@ invert and
+;
+
+\ read the pins masked as input
+: pin@ ( pinmask portaddr -- c )
+ 1- 1- c@ and
+;
+
+\ toggle the pin
+: toggle ( pinmask portaddr -- )
+ 2dup pin_high? if
+ low
+ else
+ high
+ then
+;
+
+\ disable the pull up resistor
+: pin_pullup_off ( pinmask portaddr -- )
+ 2dup pin_input low
+;
+
+
+\ enable the pull up resistor
+: pin_pullup_on ( pinmask portaddr -- )
+ 2dup pin_input high
+;
diff --git a/amforth-6.5/avr8/lib/calc-baudrate.frt b/amforth-6.5/avr8/lib/calc-baudrate.frt
new file mode 100644
index 0000000..015eb10
--- /dev/null
+++ b/amforth-6.5/avr8/lib/calc-baudrate.frt
@@ -0,0 +1,12 @@
+
+\ calculates the baudrate register values
+\ the two bytes of the result should be
+\ transferred in high - low order
+
+\ ( baudrate -- baud-rate-register)
+: calc-baudrate
+ f_cpu
+ d2/ d2/ d2/ d2/
+ rot um/mod
+ swap drop 1-
+;
diff --git a/amforth-6.5/avr8/lib/dot-res.frt b/amforth-6.5/avr8/lib/dot-res.frt
new file mode 100644
index 0000000..398bd88
--- /dev/null
+++ b/amforth-6.5/avr8/lib/dot-res.frt
@@ -0,0 +1,19 @@
+
+\ dump free ressources
+: .res ( -- )
+ base @ >r
+ decimal
+ ver ." running at " f_cpu #1000 um/mod . drop ." kHz " cr
+ s" mcu-info" environment? if
+ 2 + @i 2/ dp -
+ ." free FLASH cells " u. cr
+ else
+ ." no flash size information available " cr
+ then
+ ." free RAM bytes " unused u. cr
+ ." used EEPROM bytes " ehere u. cr
+ ." used data stack cells " depth u. cr
+ ." used return stack cells " rp0 rp@ - 1- 1- 2/ u. cr
+ ." free return stack cells " rp@ sp0 - 1+ 1+ 2/ u. cr
+ r> base !
+;
diff --git a/amforth-6.5/avr8/lib/eallot.frt b/amforth-6.5/avr8/lib/eallot.frt
new file mode 100644
index 0000000..73939cc
--- /dev/null
+++ b/amforth-6.5/avr8/lib/eallot.frt
@@ -0,0 +1,5 @@
+\ allocate n bytes in EEPROM
+
+: eallot ( n -- )
+ ehere + to ehere
+;
diff --git a/amforth-6.5/avr8/lib/forth2012/core-ext.frt b/amforth-6.5/avr8/lib/forth2012/core-ext.frt
new file mode 100644
index 0000000..7e16121
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core-ext.frt
@@ -0,0 +1,13 @@
+\ 'core-ext.frt' generated automatically, do not edit
+#require case.frt
+\ #require case-test.frt
+#require compile-comma.frt
+\ #require exceptions.frt
+#require marker.frt
+\ #require marker-test.frt
+
+\ update the environment
+\ get-current environment set-current
+\ : core-ext 0 ;
+\ reset the definition word list
+\ set-current
diff --git a/amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt b/amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt
new file mode 100644
index 0000000..0421ab3
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt
@@ -0,0 +1,20 @@
+\ the following code works in the AVR only
+
+\ use the eeprom to keep the XT. Unlike the RAM/USER
+\ based locations, the EEPROM vector is available without
+\ initialization.
+: Edefer ( "name" -- )
+ (defer)
+ ehere dup ,
+ ['] Edefer@ ,
+ ['] Edefer! ,
+ cell+ to ehere
+;
+
+\ the flash is writable, not that often, but it is
+: Idefer ( "name" -- )
+ (defer)
+ ['] noop , \ a dummy action as place holder
+ [: @i execute ;] , \ XT is directly in the dictionary.
+ [: !i ;] ,
+;
diff --git a/amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt b/amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt
new file mode 100644
index 0000000..3a7c9b0
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt
@@ -0,0 +1,18 @@
+#include dumper.frt
+#include order.frt
+#include marker.frt
+
+wordlist constant test-wl
+get-order test-wl swap 1+ set-order
+order
+marker empty
+
+' empty 4 - 10 idump
+
+: hallo ." Hallo " ;
+
+order
+words
+empty
+words
+order
diff --git a/amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt b/amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt
new file mode 100644
index 0000000..8d5756b
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt
@@ -0,0 +1,23 @@
+\ Defines a word which resets the dictionary and removes itself
+\ when called.
+\ Better then forget but still has limitations.
+
+\ all information is in the first few EEPROM cells.
+\ (marker) is a value that holds the max eeprom address
+
+: marker
+ \ get information to remove the marker itself
+ get-current @e dp
+ \ create the wordlist entry
+ create
+ \ save all data
+ (marker) 0 do i @e , 2 +loop
+ \ save the marker-remove data
+ , ,
+ does>
+ \ restore data from saved state
+ (marker) 0 do dup @i i !e 1+ 2 +loop
+ \ purge the marker itself
+ dup @i to dp
+ 1+ @i get-current !e
+;
diff --git a/amforth-6.5/avr8/lib/forth2012/core.frt b/amforth-6.5/avr8/lib/forth2012/core.frt
new file mode 100644
index 0000000..5db1994
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core.frt
@@ -0,0 +1,26 @@
+\ 'core.frt' generated automatically, do not edit
+#require 2over.frt
+#require 2swap.frt
+#require aligned.frt
+#require align.frt
+#require blank.frt
+#require c-comma.frt
+#require char-plus.frt
+#require chars.frt
+#require dot-paren.frt
+#require environment-q.frt
+#require erase.frt
+#require evaluate.frt
+#require fm-slash-mod.frt
+#require star-slash.frt
+#require move.frt
+
+#require sm-slash-rem.frt
+#require source-id.frt
+#require find.frt
+
+\ update the environment
+get-current environment set-current
+: core -1 ;
+\ reset the definition word list
+set-current
diff --git a/amforth-6.5/avr8/lib/forth2012/core/align.frt b/amforth-6.5/avr8/lib/forth2012/core/align.frt
new file mode 100644
index 0000000..e68f679
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/align.frt
@@ -0,0 +1,3 @@
+\ atmega's are always aligned
+: align ;
+
diff --git a/amforth-6.5/avr8/lib/forth2012/core/aligned.frt b/amforth-6.5/avr8/lib/forth2012/core/aligned.frt
new file mode 100644
index 0000000..f2b942a
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/aligned.frt
@@ -0,0 +1,3 @@
+\ atmega's are always aligned
+: aligned ;
+
diff --git a/amforth-6.5/avr8/lib/forth2012/core/avr-values.frt b/amforth-6.5/avr8/lib/forth2012/core/avr-values.frt
new file mode 100644
index 0000000..a23d0be
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/avr-values.frt
@@ -0,0 +1,11 @@
+
+
+\ EEPROM based values
+
+: Evalue ( n -- )
+ (value)
+ ehere ,
+ ['] Edefer@ ,
+ ['] Edefer! ,
+ ehere dup cell+ to ehere !e
+;
diff --git a/amforth-6.5/avr8/lib/forth2012/core/c-comma.frt b/amforth-6.5/avr8/lib/forth2012/core/c-comma.frt
new file mode 100644
index 0000000..2c4e678
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/c-comma.frt
@@ -0,0 +1,3 @@
+\ a character occupies a full flash cell
+: c, , ;
+
diff --git a/amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt b/amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt
new file mode 100644
index 0000000..5cb2ceb
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt
@@ -0,0 +1,15 @@
+\ internal EEPROM routines. They do not operate on external
+\ storage
+
+\ Ebuffer: is the EEPROM pendant to buffer: from forth200x
+\ it takes the number of bytes to allocate in RAM and parses
+\ SOURCE for the name to give to the buffer
+
+\ Eallot is the EEPROM pendant for allot from the core word set
+\ it allocates n bytes of EEPROM storage and return the starting
+\ address.
+
+: Eallot ehere + to ehere ;
+: Ebuffer: ehere constant Eallot ;
+
+\ for usage see http://amforth.sourceforge.net/TG/recipes/EEPROM.html
diff --git a/amforth-6.5/avr8/lib/forth2012/core/environment-q.frt b/amforth-6.5/avr8/lib/forth2012/core/environment-q.frt
new file mode 100644
index 0000000..e16428d
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/environment-q.frt
@@ -0,0 +1,53 @@
+\ environment queries are placed in a
+\ separate wordlist.
+
+\ #require imove.frt
+
+\ we have to distinguish between interpreted (RAM)
+\ and compiled (Flash) strings. First the RAM
+\ strings
+
+: (environment?) \ addr len -- 0|x*i -1
+ environment search-wordlist dup
+ if >r execute r> then
+;
+
+
+\ the compiled (Flash) strings are transferred
+\ to RAM and this copy processed afterwards.
+: [environment?]
+ ( iaddr len -- )
+ dup >r
+ here imove
+ here r> (environment?)
+;
+
+\ a state smart word to decide what to do.
+: environment?
+ state @ if
+ postpone [environment?]
+ else
+ (environment?)
+ then
+; immediate
+
+\ some environment queries
+
+\ save the definitions word list for this file
+\ and switch to the environment queries wordlist
+get-current environment set-current
+
+: /counted-strings &60 ;
+: floored 0 ;
+: address-unit-bits $10 ;
+: max-char $ff ;
+: max-d $7fffffff. ;
+: max-ud $ffffffff. ;
+: max-n $7fff ;
+: max-u $ffff ;
+
+: return-stack-cells &10 ;
+: stack-cells &10 ;
+
+\ reset the definition word list
+set-current
diff --git a/amforth-6.5/avr8/lib/forth2012/core/evaluate.frt b/amforth-6.5/avr8/lib/forth2012/core/evaluate.frt
new file mode 100644
index 0000000..80659bc
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/evaluate.frt
@@ -0,0 +1,46 @@
+\ evaluate
+\ temporarily redirect the input source
+\ to string buffer. Return the the previous
+\ input source afterwards and continue
+
+\ #require imove.frt
+
+\ some helper words
+variable strlen
+variable str
+: source-string str @ strlen @ ;
+
+\ we have to distinguish between interpreted (RAM)
+\ and compiled (Flash) strings. First the RAM
+\ strings
+
+: (evaluate) \ i*x addr len -- j*y
+ ['] source defer@ >r
+ >in @ >r
+ 0 >in !
+ strlen !
+ str !
+ ['] source-string is source
+ ['] interpret catch
+ r> >in !
+ r> is source
+ throw
+;
+
+\ the compiled (Flash) strings are transferred
+\ to RAM and processed there.
+: [evaluate]
+ ( iaddr len -- )
+ dup >r
+ here imove
+ here r> (evaluate)
+;
+
+\ a state smart word to decide what to do.
+: evaluate
+ state @ if
+ postpone [evaluate]
+ else
+ (evaluate)
+ then
+; immediate
diff --git a/amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt b/amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt
new file mode 100644
index 0000000..dfb10e9
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt
@@ -0,0 +1,22 @@
+
+
+: fm/mod ( d1 n1 -- n2 n3 )
+ dup >r
+ 2dup xor >r
+ >r
+ dabs r@ abs um/mod
+ swap r> ?negate swap
+ r> 0< if
+ negate
+ over if
+ r@ rot - swap 1-
+ then
+ then
+ r> drop
+;
+
+\ alternative solution
+\
+\ : FM/MOD \ ( d m -- r q ) signed floored division
+\ DUP >R SM/REM 2DUP 0< AND IF 1- SWAP R> + SWAP ELSE R> DROP THEN ;
+\ \ No newline at end of file
diff --git a/amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt b/amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt
new file mode 100644
index 0000000..baf07cf
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt
@@ -0,0 +1,8 @@
+
+: sm/rem ( d1 n1 -- n2 n3 )
+ 2dup xor >r
+ over >r
+ abs >r dabs r> um/mod
+ swap r> ?negate
+ swap r> ?negate
+;
diff --git a/amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt b/amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt
new file mode 100644
index 0000000..9d47a61
--- /dev/null
+++ b/amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt
@@ -0,0 +1,4 @@
+
+\ #require sm-slash-rem.frt
+
+: */mod >r m* r> sm/rem ;
diff --git a/amforth-6.5/avr8/lib/hardware/25xxx.frt b/amforth-6.5/avr8/lib/hardware/25xxx.frt
new file mode 100644
index 0000000..2951810
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/25xxx.frt
@@ -0,0 +1,131 @@
+
+ 6 constant SEE_WREN
+ 4 constant SEE_WRDI
+ 5 constant SEE_RDSR
+ 1 constant SEE_WRSR
+ 3 constant SEE_READ
+ 2 constant SEE_WRITE
+$AB constant SEE_RDID \ Microchip 25LCxxx only; remove from deep power-down
+
+ : 25xxx_disable \ raise serial EEPROM chip-select line high
+ 25XXX_CS_A_MASK
+ 25XXX_CS_A_PORT c@
+ or
+ 25XXX_CS_A_PORT c!
+ ;
+
+ : 25xxx_enable ( -- ) \ pull serial EEPROM chip-select line low
+ 25XXX_CS_A_MASK invert
+ 25XXX_CS_A_PORT c@
+ and
+ 25XXX_CS_A_PORT c!
+ ;
+
+ : 25xxx_c! ( c addr -- ) \ writes char in NOS to serial EEPROM, address in TOS
+ 25xxx_enable
+ 25XXX_WREN spi_send \ send enable-write command, ignore response
+ 25xxx_disable
+
+ 25xxx_enable
+ 25XXX_WRITE spi_send \ send write command, ignore response
+ 25xxx_sendaddr \ send addr (16 or 24 bits)
+ spi_send \ write byte
+ 25xxx_disable
+ 25xxx_wait_rdy
+ ;
+
+ : 25xxx_! ( w seeaddrl seeaddrh -- ) \ write word in NOS to serial EEPROM at addr in TOS
+ 2>r dup >< 2r> \ fast way to prep data in stack ( wl wh seeaddrl seeaddrh )
+ over over 1 0 d+ \ precalc addr of second byte in data
+ 2>r \ save for later ( wl wh seeaddrl seeaddrh )
+ 25xxx_c! \ write MSB of word ( wl )
+ 2r> \ recover addr of next byte ( wl seeaddrl+1 seeaddrh )
+ 25xxx_c! \ write LSB
+ ;
+
+ : 25xxx_wait_rdy ( -- ) \ busy-wait until serial EEPROM finishes writing
+ begin
+ 25xxx_enable
+ 25XXX_RDSR spi_xchg drop \ send read-status command, ignore response
+ 0 spi_xchg \ send null byte, response is on TOS
+ 25xxx_disable
+ 1 and \ isolate the WIP (write-in-progress) bit
+ 1 xor \ reverse state of WIP bit
+ until \ loop until WIP = 0
+ ;
+
+ : see_c@ ( addrl addrh -- c ) \ returns byte at 32-bit address in TOS
+ 25xxx_enable
+ 25XXX_READ spi_send \ send READ command, ignore response
+ 25xxx_sendaddr \ send address (16 or 24 bits)
+ 0 spi_xchg \ send null byte, response is in TOS
+ 25xxx_disable
+ ;
+
+ : 25xxx_c@_blk ( addr n eeaddrl eeaddrh -- )
+ 25xxx_enable
+ 25XXX_READ spi_send \ send READ command, ignore response
+ 25xxx_sendaddr \ send address (16 or 24 bits)
+ 0 \ ( -- addr n 0 )
+ do \ for all requested bytes...
+ 0 spi_xchg \ get byte from serial EEPROM
+ over \ get addr to use
+ c! \ save the byte
+ 1+ \ bump pointer
+ loop
+ drop \ done with address
+ 25xxx_disable
+ ;
+
+
+ : 25xxx_c!blk ( addr n seeaddrl seeaddrh -- ) \ copies N bytes from addr to EEPROM address in TOS/NOS
+ 25xxx_enable
+ 25XXX_WREN spisend \ need to enable serial EEPROM for writing
+ 25xxx_disable
+
+ 25xxx_enable
+ 25XXX_WRITE spi_send \ send WRITE command, ignore response
+ over over \ copy of 32-bit serial EEPROM addr
+ 25xxx_sendaddr \ send addr to serial EEPROM ( -- addr n seeaddrl seeaddrh )
+ rot \ ( -- addr seeaddrl seeaddrh n )
+ 0 \ ( -- addr seeaddrl seeaddrh n 0 )
+ do \ for all requested bytes ( -- addr seeaddrl seeaddrh )
+ rot dup i + \ addr of byte to fetch ( -- seeaddrl seeaddrh addr addr+i )
+ c@ spi_send \ write to serial EEPROM ( -- seeaddrl seeaddrh addr )
+ rot dup i + \ calc addr within serial EEPROM ( -- seeaddrh addr seeaddrl seeaddrl+i )
+ 7f and 7f = \ last addr in page?; use 7f for 25LC256/512, 3f for AT25128/256
+ if
+ 25xxx_disable \ done with this page
+ 25xxx_wait_rdy
+ 25xxx_enable
+ 25XXX_WREN spi_send \ need to enable serial EEPROM for writing
+ 25xxx_disable
+ 25xxx_enable
+ 25XXX_WRITE spi_send \ send WRITE command ( -- seeaddrh addr seeaddrl )
+ rot \ set up EEPROM addr ( -- addr seeaddrl seeaddrh )
+ over over \ get a copy
+ i 1+ 0 d+ \ calc addr of next page ( -- addr seeaddrl seeaddrh seeaddrl seeaddrh )
+ 25xxx_sendaddr \ send addr to serial EEPROM ( -- addr seeaddrl seeaddrh)
+ else \ not start of new page ( -- seeaddrh addr seeaddrl )
+ rot \ rearrange ( -- addr seeaddrl seeaddrh )
+ then
+ loop
+ drop
+ drop drop
+ 25xxx_disable
+ 25xxx_wait_rdy
+ ;
+
+
+ : 25xxx_init ( -- ) \ initialize SPI and I/O ports for accessing serial EEPROM
+ spi_init
+ 25XXX_CS_A_DDR c@
+ 25XXX_CS_A_MASK or \ need to make CS an output
+ 25XXX_CS_A_DDR c!
+ 25xxx_enable
+ 25XXX_RDID spi_xchg drop \ Microchip 25LCxxx only; take chip out of deep power-down
+ 0 spi_xchg drop \ need to send dummy 16-bit addr, ignore response
+ 0 spi_xchg drop
+ 0 spi_xchg drop \ one last null byte, Microchip devices will send ID, ignore it
+ 25xxx_disable
+ ;
diff --git a/amforth-6.5/avr8/lib/hardware/flash-block.frt b/amforth-6.5/avr8/lib/hardware/flash-block.frt
new file mode 100644
index 0000000..661e3b4
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/flash-block.frt
@@ -0,0 +1,37 @@
+\
+\ flash-block
+\ contiguous flash region used a block storage
+\
+\ requires blocks.frt (for init and blocksize)
+\
+
+\ start address for blocks.
+\ the block data starts at
+\ flash.base-addr + (blocknum*blocksize)
+\ it could be beyond the 128K limit, if the
+\ !i and @i are replaced by words which take a
+\ doube cell address or handle the block at once
+\ (preferred)
+\
+variable flash.base-addr
+
+\ remember a flash cell contains 2 bytes
+
+: flash.load-buffer ( a-addr u -- )
+ 1- blocksize 2/ * flash.base-addr @ +
+ blocksize 2/ bounds ?do i @i over ! cell+ loop drop
+;
+
+: flash.save-buffer ( a-addr u -- )
+ 1- blocksize 2/ * flash.base-addr @ +
+ ." still debugging. no actual flash write!"
+ blocksize 2/ bounds ?do dup @ i 2drop ( !i) cell+ loop drop
+;
+
+\ for turnkey
+: flash.init ( -- )
+ ['] flash.load-buffer is load-buffer
+ ['] flash.save-buffer is save-buffer
+ 0 flash.base-addr !
+ block:init
+;
diff --git a/amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt b/amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt
new file mode 100644
index 0000000..3bd2190
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt
@@ -0,0 +1,136 @@
+\ basic I2C operations, uses 7bit bus addresses
+\ uses the TWI module of the Atmega's.
+
+#require bitnames.frt
+#require avr-values.frt
+
+\ provides public commands
+\ i2c.ping? -- checks if addr is active
+\ i2c.init -- flexible configuration setup. see below
+\ i2c.init.default -- generic slow speed setup
+\ i2c.off -- turns off I2C
+
+\ and more internal commands
+\ i2c.wait -- wait for the current i2c transaction
+\ i2c.start -- send start condition
+\ i2c.stop -- send stop condition
+\ i2c.tx -- send one byte, wait for ACK
+\ i2c.rx -- receive one byte with ACK
+\ i2c.rxn .. receive one byte with NACK
+\ i2c.status -- get the last i2c status
+
+\
+\ i2c (SCL) clock speed = CPU_clock/(16 + 2*bitrateregister*(4^prescaler))
+\ following the SCL clock speed in Hz for an 8Mhz device
+\ bitrate register (may be any value between 0 and 255)
+\ 4 8 16 32 64 128 255
+\ prescaler
+\ /1 333.333 250.000 166.667 100.000 55.556 29.412 15.209
+\ /4 166.667 100.000 55.556 29.412 15.152 7.692 3.891
+\ /16 55.556 29.412 15.152 7.692 3.876 1.946 978
+\ /64 15.152 7.692 3.876 1.946 975 488 245
+\
+\
+
+-#4000 constant i2c.timeout \ exception number for timeout
+#10000 Evalue i2c.maxticks \ # of checks until timeout is reached
+variable i2c.loop \ timeout counter
+variable i2c.current \ current hwid if <> 0
+
+: i2c.timeout?
+ i2c.loop @ 1- dup i2c.loop ! 0=
+;
+
+\ turn off i2c
+: i2c.off ( -- )
+ 0 TWCR c!
+ 0 i2c.current !
+;
+
+#0 constant i2c.prescaler/1
+#1 constant i2c.prescaler/4
+#2 constant i2c.prescaler/16
+#3 constant i2c.prescaler/64
+TWSR $3 bitmask: i2c.conf.prescaler
+
+TWCR #7 portpin: i2c.int
+TWCR #6 portpin: i2c.ea
+TWCR #5 portpin: i2c.sta
+
+\ enable i2c
+: i2c.init ( prescaler bitrate -- )
+ i2c.off \ stop i2c, just to be sure
+ TWBR c! \ set bitrate register
+ i2c.conf.prescaler pin! \ the prescaler has only 2 bits
+;
+
+\ a very low speed initialization.
+: i2c.init.default
+ i2c.prescaler/64 #3 i2c.init
+;
+
+\ wait for i2c finish
+: i2c.wait ( -- )
+ i2c.maxticks i2c.loop !
+ begin
+ pause \ or 1ms?
+ i2c.int is_high?
+ i2c.timeout? if i2c.timeout throw then
+ until
+;
+
+\ send start condition
+: i2c.start ( -- )
+ %10100100 TWCR c!
+ i2c.wait
+;
+
+\ send stop condition
+: i2c.stop ( -- )
+ %10010100 TWCR c!
+ \ no wait for completion.
+;
+
+\ send the restart condition (AVR simply sends start again)
+: i2c.restart ( -- )
+ i2c.start
+;
+
+\ process the data, waits for completion
+: i2c.action
+ %10000100 or TWCR c! \ _BV(i2cNT)|_BV(TWEN)
+ i2c.wait
+;
+
+\ send 1 byte
+: i2c.tx ( c -- )
+ TWDR c!
+ 0 i2c.action
+;
+
+\ receive 1 byte, send ACK
+: i2c.rx ( -- c )
+ %01000000 \ TWEA
+ i2c.action
+ TWDR c@
+;
+
+\ receive 1 byte, send NACK
+: i2c.rxn ( -- c )
+ 0 i2c.action
+ TWDR c@
+;
+
+\ get i2c status
+: i2c.status ( -- n )
+ TWSR c@
+ $f8 and
+;
+
+\ detect presence of a device on the bus
+: i2c.ping? ( addr -- f )
+ i2c.start
+ 2* i2c.tx
+ i2c.status $18 =
+ i2c.stop
+;
diff --git a/amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt b/amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt
new file mode 100644
index 0000000..c045433
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt
@@ -0,0 +1,89 @@
+\ the following code is work in progress.
+\ debug output and other oddities are possible
+
+\ The slave provides a circular buffer of
+\ $10 bytes size. The variables i2c-in
+\ and i2c-out are pointers to the next
+\ byte in this buffer.
+\
+
+\ #require buffer.frt
+
+$10 constant i2c-bufsize
+
+i2c-bufsize buffer: i2c-buffer
+variable i2c-in
+variable i2c-out
+
+: ++wrap ( addr -- n )
+ dup @ ( -- addr n )
+ dup 0 [ i2c-bufsize 1- ] literal within
+ if 1+ else drop 0 then
+ dup rot !
+;
+
+: >i2c-buffer ( c -- )
+ i2c-buffer i2c-in ++wrap + c!
+;
+
+: i2c-buffer> ( -- c )
+ i2c-buffer i2c-out ++wrap + c@
+;
+
+
+TWCR_TWEN TWCR_TWIE TWCR_TWINT or or constant TWCR_TWENALL
+
+\ set the hw address and start the receiver
+: i2c.slave.init ( hwid -- )
+ 2* \ see datasheet
+ TWAR c!
+ [ TWCR_TWENALL TWCR_TWEA or ] literal TWCR c!
+;
+
+: i2c.slave.twcr.ack
+ [ TWCR_TWENALL TWCR_TWEA or ] literal TWCR c!
+;
+: i2c.slave.twcr.nack
+ [ TWCR_TWENALL ] literal TWCR c!
+;
+
+: i2c.slave.twcr.reset
+ [ TWCR_TWENALL TWCR_TWEA TWCR_TWSTO or or ] literal TWCR c!
+;
+
+\ own address received with ACK
+: i2c.addr.ack ( -- )
+ \ well, nothing to do
+ i2c.slave.twcr.ack
+;
+
+\ data received with NACK, probably the last one
+: i2c.data.nack ( -- )
+ TWDR c@ >i2c-buffer
+ i2c.slave.twcr.nack
+;
+\ data received with ACK, more to follow
+: i2c.data.ack ( -- )
+ TWDR c@ >i2c-buffer
+ i2c.slave.twcr.ack
+;
+
+: i2c.data.send ( -- )
+ i2c-buffer> TWDR c!
+ i2c.slave.twcr.ack
+;
+
+: i2c.slave.isr ( -- )
+ TWSR c@ $f8 and
+ \ receiving data
+ dup $60 = if drop i2c.addr.ack exit then \ TW_SR_SLA_ACK
+ dup $80 = if drop i2c.data.ack exit then \ TW_SR_SLA_ACK
+ dup $88 = if drop i2c.data.nack exit then \ TW_SR_SLA_NACK
+ \ sending data
+ dup $a8 = if drop i2c.data.send exit then \ TW_ST_SLA_ACK
+ dup $b8 = if drop i2c.data.send exit then \ TW_ST_DATA_ACK
+ drop i2c.slave.twcr.reset
+;
+
+' i2c.slave.isr decimal TWIAddr int!
+$42 i2c.slave.init
diff --git a/amforth-6.5/avr8/lib/hardware/int-q.frt b/amforth-6.5/avr8/lib/hardware/int-q.frt
new file mode 100644
index 0000000..923e000
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/int-q.frt
@@ -0,0 +1,2 @@
+
+: int? SREG c@ SREG_I and 0> ; \ AVR
diff --git a/amforth-6.5/avr8/lib/hardware/interrupts.frt b/amforth-6.5/avr8/lib/hardware/interrupts.frt
new file mode 100644
index 0000000..d6eae22
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/interrupts.frt
@@ -0,0 +1,7 @@
+\ initialize interrupt vectors
+
+: initIntVectors
+ #int 0 do
+ ['] noop i int!
+ loop
+;
diff --git a/amforth-6.5/avr8/lib/hardware/key2char.frt b/amforth-6.5/avr8/lib/hardware/key2char.frt
new file mode 100644
index 0000000..37e3d45
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/key2char.frt
@@ -0,0 +1,135 @@
+\ Convert tab for Keyboard.frt - Lubos Pekny, www.forth.cz
+\ V.1.0, 26.05.2008
+\ keyboard scan code->ascii char, 128 words, Hi:Lo byte (Hi is with shift)
+
+create kbd_CHARTAB
+\ ascii key char char^
+0000 , \ 00
+0000 , \ 01 F9
+0000 , \ 02
+0000 , \ 03 F5
+0000 , \ 04 F3
+0000 , \ 05 F1
+0000 , \ 06 F2
+0000 , \ 07 F12
+0000 , \ 08
+0000 , \ 09 F10
+0000 , \ 0A F8
+0000 , \ 0B F6
+0000 , \ 0C F4
+0909 , \ 0D TAB
+7E60 , \ 0E ` ~
+0000 , \ 0F
+0000 , \ 10
+0000 , \ 11 ALT
+0000 , \ 12 Left SHIFT
+0000 , \ 13
+0000 , \ 14 Ctrl
+5171 , \ 15 q Q
+2131 , \ 16 1 !
+0000 , \ 17
+0000 , \ 18
+0000 , \ 19
+5A7A , \ 1A z Z
+5373 , \ 1B s S
+4161 , \ 1C a A
+5777 , \ 1D w W
+4032 , \ 1E 2 @
+0000 , \ 1F
+0000 , \ 20
+4363 , \ 21 c C
+5878 , \ 22 x X
+4464 , \ 23 d D
+4565 , \ 24 e E
+2434 , \ 25 4 $
+2333 , \ 26 3 #
+0000 , \ 27
+0000 , \ 28
+2020 , \ 29 Space
+5676 , \ 2A v V
+4666 , \ 2B f F
+5474 , \ 2C t T
+5272 , \ 2D r R
+2535 , \ 2E 5 %
+0000 , \ 2F
+0000 , \ 30
+4E6E , \ 31 n N
+4262 , \ 32 b B
+4868 , \ 33 h H
+4767 , \ 34 g G
+5979 , \ 35 y Y
+5E36 , \ 36 6 ^
+0000 , \ 37
+0000 , \ 38
+0000 , \ 39
+4D6D , \ 3A m M
+4A6A , \ 3B j J
+5575 , \ 3C u U
+2637 , \ 3D 7 &
+2A38 , \ 3E 8 *
+0000 , \ 3F
+0000 , \ 40
+3C2C , \ 41 , <
+4B6B , \ 42 k K
+4969 , \ 43 i I
+4F6F , \ 44 o O
+2930 , \ 45 0 )
+2839 , \ 46 9 (
+0000 , \ 47
+0000 , \ 48
+3E2E , \ 49 . >
+3F2F , \ 4A / ?
+4C6C , \ 4B l L
+3A3B , \ 4C ; :
+5070 , \ 4D p P
+5F2D , \ 4E - _
+0000 , \ 4F
+0000 , \ 50
+0000 , \ 51
+2227 , \ 52 ' "
+0000 , \ 53
+7B5B , \ 54 [ {
+2B3D , \ 55 = +
+0000 , \ 56
+0000 , \ 57
+0000 , \ 58 Caps Lock
+0000 , \ 59 Right Shift
+0D0D , \ 5A Enter
+7D5D , \ 5B ] }
+0000 , \ 5C
+7C5C , \ 5D \ |
+0000 , \ 5E
+0000 , \ 5F
+0000 , \ 60
+0000 , \ 61
+0000 , \ 62
+0000 , \ 63
+0000 , \ 64
+0000 , \ 65
+0808 , \ 66 Backspace
+0000 , \ 67
+0000 , \ 68
+3100 , \ 69 END, NUM 1
+0000 , \ 6A
+3400 , \ 6B LEFT, NUM 4
+3700 , \ 6C HOME, NUM 7
+0000 , \ 6D
+0000 , \ 6E
+0000 , \ 6F
+3000 , \ 70 INS, NUM 0
+2E00 , \ 71 DEL, NUM .
+3200 , \ 72 DOWN, NUM 2
+3500 , \ 73 , NUM 5
+3600 , \ 74 RIGHT,NUM 6
+3800 , \ 75 UP, NUM 8
+1B1B , \ 76 ESC
+0000 , \ 77 NUM LOCK
+0000 , \ 78 F11
+2B2B , \ 79 NUM +
+3300 , \ 7A PgDwn,NUM 3
+2D2D , \ 7B NUM -
+2A2A , \ 7C NUM *
+3900 , \ 7D PgUp, NUM 9
+0000 , \ 7E SCROLL LOCK
+0000 , \ 7F
+\ 83 F7
diff --git a/amforth-6.5/avr8/lib/hardware/keyboard.frt b/amforth-6.5/avr8/lib/hardware/keyboard.frt
new file mode 100644
index 0000000..7182f26
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/keyboard.frt
@@ -0,0 +1,486 @@
+\ Keyboard PS/2 - Lubos Pekny, www.forth.cz
+\ Library for amforth 3.0 mFC 1.0
+
+\ V.1.2v, 29.01.2009, add vocabulary
+
+\ V.1.2, 14.01.2009, tested on atmega32, amforth 3.0
+\ - add err bit in kbd_FLGR
+\ - add sync to kbd_ekey?
+
+\ V.1.1, 06.07.2008, tested on atmega32, amforth 2.7
+\ - changes in key->ps2, kbd_ascii, kbd_sync, appl_kbdlcd
+\ - optimalized restart and clk-sync
+
+\ V.1.0, 03.07.2008, tested on atmega32, amforth 2.7
+\ - used INT2 + 1 pin
+\ - kbd_init kbd_char kbd_ekey? kbd_ekey
+\ - ekey? ekey ekey>char ekey>fkey key? key
+
+\ a = char a $61
+\ shift+a = char A $41
+\ ctrl+a = no char, events $401C
+\ ctrl+shift+a = char $01
+\ alt+char = $80+char
+\ alt+ctrl+shift+a = char $81
+
+#include key2char.frt \ V 1.0, 26.05.2008
+
+hex
+
+forth
+<bit> definitions \ into vocabulary <bit>
+
+38 constant PORTB \ Atmega32, PB.2 (INT2)<-clk, PB.1 (in)<-data out
+
+forth
+<kbd> definitions \ into vocabulary <kbd>
+
+variable PENDING-CHAR \ for key?, key
+variable kbd_CNTR \ r4:w4:b8, 8bit+2x4b circular buf counters
+variable kbd_ROTR \ received bits from keyboard
+variable kbd_FLGR \ flags, final hi=|alt|ctrl|shift|num|releas|extend|0|err|
+ \ work lo=|altL|altR|ctrlL|ctrlR|shiftL|shiftR|caps|num|
+variable kbd_SKEY \ keyboard scan code+flags
+ 8 cells allot \ 8 events buf
+
+8000 constant K-ALT-MASK
+4000 constant K-CTRL-MASK
+2000 constant K-SHIFT-MASK
+1000 constant K-NUM-MASK
+0800 constant K-RELEAS-MASK
+0400 constant K-EXTEND-MASK
+0100 constant K-EVENTS-MASK
+
+
+ \ interrupt, keyboard clock
+code kbd_clk
+ R18 push,
+ R18 3F in, \ SREG 0x3F(0x5F)
+ R18 push,
+ R17 push, R16 push,
+ ZH push, ZL push,
+
+\ --- Receive bits --
+ R16 kbd_ROTR lds, \ received bits reg
+ R17 kbd_ROTR 1+ lds,
+ clc, \ CY=0
+ <bit> PORTB assembler
+ 22 - 1 sbic, \ PinB.1=1 then CY=1
+ sec,
+ R17 ror, R16 ror, \ CY->R17.7->R16, rotate
+ kbd_ROTR 1+ R17 sts,
+ kbd_ROTR R16 sts, \ update variable kbd_ROTR
+
+ R18 kbd_CNTR lds, \ bit counter reg
+ R18 0F andi,
+ R18 00 cpi, \ =0 then 0B
+ adr> brne,
+ R18 0B ldi,
+ <labelb
+ R18 0B cpi, \ >=0B then 0B
+ adr> brcs,
+ R18 0B ldi,
+ <labelb
+ R18 dec, \ dec bit counter, 0A..00
+ kbd_CNTR R18 sts, \ update variable kbd_CNTR
+ adr> brne, 0 >lbl \ all 8+3 bits? else end
+
+ R16 rol,
+ R17 rol, \ CY=stopbit
+ adr> brcc, 1 >lbl \ CY=0 then error end
+ R16 rol,
+ R17 rol, \ CY=parity, data
+ R16 rol, \ CY=startbit
+ adr> brcs, 2 >lbl \ CY=1? then error end
+
+\ --- Entry point, R17-scan code
+
+ ZL kbd_FLGR lds, \ work flags
+ ZH kbd_FLGR 1+ lds, \ final flags
+
+ R18 kbd_CNTR 1+ lds, \ buf counters
+ R16 R18 mov, \ read:write counter
+ R16 swap,
+ R18 inc, \ wr+1, next position
+ R18 07 andi, \ 3b counters
+ R16 0F andi,
+ R16 R18 cp, \ rd=wr+1? ->no overwrite buf
+ adr> breq, 3 >lbl \ end
+
+ R16 swap,
+ R16 R18 or, \ rd:wr+1, update counter
+
+ R17 E0 cpi, \ data>=E0 then no update
+ adr> brcc, 4 >lbl \ skip for EXTEND or RELEAS
+
+ kbd_CNTR 1+ R16 sts, \ update position
+
+\ --- Flags ---
+ adr> rcall, 5 >lbl \ make work flags
+ adr> rcall, 6 >lbl \ make final flags
+
+\ --- Write to the buf ---
+ R16 clr, \ write to the kbd_SKEY buf
+ R18 lsl, \ 2*(wr+1)
+ ZL kbd_SKEY ldi, \ addr buf
+ ZH kbd_SKEY >< ldi,
+ ZL R18 add,
+ ZH R16 adc, \ ZH:ZL+0:R18
+ Z+ R17 st, \ scan code->lo(kbd_SKEY+wr)
+ R17 kbd_FLGR 1+ lds,
+ Z+ R17 st, \ flags->hi(kbd_SKEY+wr)
+ kbd_FLGR 1+ R16 sts, \ clear final flags
+ R16 R16 cpse, \ end
+
+\ --- EXTEND or RELEAS ---
+ 4 <lbl <labelb
+ adr> rcall, 7 >lbl \ set flag EXTEND or RELEAS
+
+\ --- End ---
+ 3 <lbl <labelb \ from No everwrite
+ 0 <lbl <labelb \ from No all bits
+ label> \ from Set err
+ ZL pop, ZH pop,
+ R16 pop, R17 pop,
+ R18 pop, 3F R18 out,
+ R18 pop,
+ reti,
+
+\ --- Set err ---
+ 2 <lbl <labelb
+ 1 <lbl <labelb
+ R17 kbd_FLGR 1+ lds,
+ R17 1 ori,
+ kbd_FLGR 1+ R17 sts, \ set err in final flags
+ <radr rjmp, \ jump to end
+
+
+\ --- Subroutines ---
+
+\ Set flag EXTEND or RELEAS (E0 or F0)
+ 7 <lbl <labelr \ ZH-final flags
+ R17 F0 cpi, \ R17-scan code
+ adr> brcc, \ >=F0
+ ZH K-EXTEND-MASK >< ori,
+ ZH ZH cpse,
+ <labelb
+ ZH K-RELEAS-MASK >< ori,
+ kbd_FLGR 1+ ZH sts, \ update final flags
+ ret,
+
+
+\ Make work flags, Caps, LShift, RShift, etc.
+ 5 <lbl <labelr \ R17-scan code, ZL-work flags
+ R16 clr,
+ R17 77 cpi, \ num
+ 1 brne,
+ R16 01 ldi,
+ R17 58 cpi, \ caps
+ 1 brne,
+ R16 02 ldi,
+ R17 59 cpi, \ Rshift
+ 1 brne,
+ R16 04 ldi,
+ R17 12 cpi, \ Lshift
+ 1 brne,
+ R16 08 ldi,
+
+ ZH 02 sbrc, \ E0?
+ adr> rjmp, \ jmp EXTEND
+
+ R17 14 cpi, \ ctrl no EXTEND
+ 1 brne,
+ R16 10 ldi,
+ R17 11 cpi, \ alt
+ 1 brne,
+ R16 40 ldi,
+ adr> rjmp, \ jmp test F0
+
+ swap <labelr \ yes EXTEND
+ R17 14 cpi, \ ctrl
+ 1 brne,
+ R16 20 ldi,
+ R17 11 cpi, \ alt
+ 1 brne,
+ R16 80 ldi,
+
+ <labelr \ test F0
+ R16 4 cpi, \ <4
+ adr> brcs, \ jmp num or caps
+ ZH 03 sbrs, \ F0?
+ adr> rjmp, \ jmp no RELEAS
+ R16 com,
+ ZL R16 and, \ clear flag
+ ZL ZL cpse, \ skip
+ <labelr \ no RELEAS
+ ZL R16 or, \ set flag
+ kbd_FLGR ZL sts, \ update work flags
+ ret,
+
+ <labelb \ num or caps
+ ZH 03 sbrc, \ F0?
+ ret, \ yes F0
+ ZL R16 eor, \ no F0, then flip
+ kbd_FLGR ZL sts, \ update work flags
+ ret,
+
+
+\ Make final flags, SHIFT=CAPS xor (LShift or RShift)
+ 6 <lbl <labelr
+ R16 K-SHIFT-MASK >< ldi,
+ ZL 7 sbrc, \ test work flags
+ ZH K-ALT-MASK >< ori, \ set final flags
+ ZL 6 sbrc,
+ ZH K-ALT-MASK >< ori,
+ ZL 5 sbrc,
+ ZH K-CTRL-MASK >< ori,
+ ZL 4 sbrc,
+ ZH K-CTRL-MASK >< ori,
+ ZL 3 sbrc,
+ ZH K-SHIFT-MASK >< ori,
+ ZL 2 sbrc,
+ ZH K-SHIFT-MASK >< ori,
+ ZL 1 sbrc,
+ ZH R16 eor,
+ ZL 0 sbrc,
+ ZH K-NUM-MASK >< ori,
+ kbd_FLGR 1+ ZH sts, \ update final flags
+ ret,
+end-code
+
+
+940C 0006 i! ' kbd_clk i@ 0007 i! \ Set INT2 vector
+
+ \ INT2 enabled, clear buf
+: kbd_init ( -- )
+ <bit>
+ -int drop
+ PORTB c@ 06 or PORTB c! \ pull-up
+ PORTB 1- c@ F9 and PORTB 1- c! \ DDRB, PB.1,2 in
+ 54 c@ BF and 54 c! \ MCUCSR.ISC2=0, 0x34(0x54).6, fall
+ 5B c@ 20 or 5B c! \ GICR.INT2=1, 0x3B(0x5B).5, enable
+ +int
+ 0 kbd_CNTR ! 0 kbd_ROTR ! 1 kbd_FLGR ! \ all reset, set num
+ 10 0 do 0 kbd_SKEY i + c! loop \ clear buffer
+ -1 PENDING-CHAR ! ;
+
+
+ \ convert scan code to visible char
+: kbd_char ( u -- char ) \ u=|alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
+ dup 7F and dup \ -- u c c
+ kbd_CHARTAB + i@ \ -- u c 2char
+ swap \ -- u 2char c
+ dup 68 > swap 7E < and \ c=69..7D then num else shift
+ if \ -- u 2char
+ swap K-NUM-MASK and \ num?
+ else
+ swap K-SHIFT-MASK and \ shift?
+ then
+ if >< then \ swap byte in 2char, Hi->Lo
+ FF and ; \ -- char
+
+
+ \ convert scan code to ascii,+ctrl+alt
+: kbd_ascii ( u -- char )
+ dup 0C00 and \ releas,extend?
+ if drop 00 exit then \ event, char 00
+ dup kbd_char \ -- u char
+ dup 0=
+ if swap drop exit then \ -- 00, isn't visible char
+ over K-CTRL-MASK and \ -- u char, ctrl?
+ if
+ dup 3F > over 60 < and \ 64<=char<96
+ if
+ 40 - \ -- char-64
+ else
+ drop drop 00 exit \ event, char 00
+ then
+ then
+ swap K-ALT-MASK and \ alt?
+ if 80 + then ; \ -- char+128
+
+
+ \ int-, set b7 in kbd_CNTR, int+
+code kbd_b7set
+ R18 push,
+ R18 3F in, \ SREG 0x3F(0x5F)
+ R18 push,
+ cli,
+ R18 kbd_CNTR lds, \ bit counter reg
+ R18 80 ori, \ set b7
+ kbd_CNTR R18 sts,
+ sei,
+ R18 pop, 3F R18 out,
+ R18 pop,
+end-code
+
+
+ \ int-, b7=1? then clear kbd_CNTR, int+
+code kbd_b7tst
+ R18 push,
+ R18 3F in, \ SREG 0x3F(0x5F)
+ R18 push,
+ cli,
+
+ R18 kbd_CNTR lds, \ bit counter reg
+ R18 rol,
+ adr> brcc, \ b7=0? then end
+ R18 clr,
+ kbd_CNTR R18 sts, \ clear bits counter
+
+ <labelb
+ sei,
+ R18 pop, 3F R18 out,
+ R18 pop,
+end-code
+
+
+ \ sync clk - set bit, wait, int2 clear this bit
+: kbd_sync ( -- ) \ v.1.1 15ms->3ms, int-, int+
+ kbd_b7set \ set b7 in kbd_CNTR
+ 3 ms
+ kbd_b7tst ; \ b7=1? then clear bits counter
+
+
+ \ keyboard events?, rd<>wr counter
+: kbd_ekey? ( -- flag )
+ kbd_FLGR 1+ c@ 1 and \ flag err is set in kbd_clk
+ if
+ kbd_FLGR 1+ dup c@ \ -- addr c
+ FE and swap c! \ clear err
+ 3 ms 0 kbd_CNTR c! \ if err then sync
+ then
+ kbd_CNTR 1+ c@ \ -- rd:wr, 3b counters
+ dup 4 lshift F0 and \ -- rd:wr wr:0
+ swap F0 and xor ; \ wr=rd?, 0 is false
+
+
+ \ Read event, scan code from buffer
+: kbd_ekey ( -- u ) \ |alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
+ begin kbd_ekey? until \ events?
+ kbd_CNTR 1+ dup c@ dup \ -- addr addr rd:wr rd:wr
+ 4 rshift 1+ 07 and \ -- addr addr rd:wr 0:rd+1
+ >r 0F and r@ 4 lshift or \ -- addr addr rd+1:wr
+ swap c! \ -- addr, update counter rd
+ r> 2* kbd_SKEY + @ \ kbd_SKEY+2*(rd+1) @
+ kbd_sync ; \ sync after stopbit
+
+
+ \ convert num '/','enter' to char
+: kbd_numchar ( u -- u|char )
+ dup 0FFF and dup \ -- u1 u2 u2
+ 054A = swap 55A = or \ -- u1 flag
+ if
+ F0FF and kbd_ascii \ num '/','enter'
+ then ;
+
+
+: ekey? ( -- flag )
+ kbd_ekey? ;
+
+
+ \ Ascii char or u scan code
+: ekey ( -- char|u )
+ kbd_ekey dup kbd_ascii \ -- u char
+ ?dup 0=
+ if
+ K-EVENTS-MASK or \ -- u+256
+ K-NUM-MASK invert and \ clear num
+ else
+ swap drop \ -- char
+ then
+ kbd_numchar ; \ '/','enter'
+
+
+: ekey>char ( u -- u false|char true)
+ dup FF u>
+ if false else true then ;
+
+
+: ekey>fkey ( u1 -- u2 flag )
+ dup ekey>char swap drop 0= ;
+
+
+: ps2key? ( -- flag )
+ PENDING-CHAR @ 0<
+ if
+ begin
+ ekey?
+ while
+ ekey ekey>char
+ if
+ PENDING-CHAR ! true exit
+ then drop
+ repeat false exit
+ then true ;
+
+
+: ps2key ( -- char )
+ PENDING-CHAR @ 0<
+ if
+ begin
+ ekey ekey>char 0=
+ while
+ drop
+ repeat exit
+ then
+ PENDING-CHAR @ -1 PENDING-CHAR ! ;
+
+
+ \ Switch key to ps2 keyboard
+: key->ps2 ( -- )
+ ['] ps2key ['] key defer!
+ ['] ps2key? ['] key? defer!
+ ['] noop ['] /key defer! ; \ v.1.1 add /key
+
+
+ \ Switch key to serial port
+: key->rx0 ( -- )
+ ['] rx0 ['] key defer!
+ ['] rx0? ['] key? defer! ;
+
+
+ \ Alone system PS2-keyboard+LCD20x4
+ \ PS2 keyboard started slowly. To delay amforth abouth 0.5s
+ \ +echo or set eeprom $14.0=H if you need view keyboard char
+: appl_kbdlcd
+ 200 ms \ v.1.1, to delay amforth or app restart
+ <lcd>
+ applturnkey
+ kbd_init scr_init
+ key->ps2 emit->scr
+ ver ;
+
+
+\ Write to the eeprom appl started after switch on.
+\ ' appl_kbdlcd 0A e! \ PS2+LCD
+\ ' applturnkey 0A e! \ UART0
+\ ' appl_mpc 0A e! \ applturnkey+slave detect
+
+
+\ ----- Test key -----
+
+ \ info about pressed key, 'Ctrl+c' end loop
+: kbd_info ( -- )
+ begin
+ ekey \ get char|event
+ dup 21 \ 'c'
+ K-EVENTS-MASK or \ event, no ascii
+ K-CTRL-MASK or <> \ ctrl+c?
+ while
+ dup u. space \ code
+ dup FF u> \ char
+ if drop else emit then
+ cr
+ repeat drop ;
+
+ \ write text, 'Esc' end loop
+: kbd_writer ( -- )
+ begin
+ ps2key \ get char
+ dup 1B <> \ Esc?
+ while
+ emit \ view char
+ repeat drop ;
+
+\ end of file
diff --git a/amforth-6.5/avr8/lib/hardware/mmc.frt b/amforth-6.5/avr8/lib/hardware/mmc.frt
new file mode 100644
index 0000000..f213c9b
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/mmc.frt
@@ -0,0 +1,371 @@
+\ MMC+SD card - Lubos Pekny, www.forth.cz
+\ Library for amforth 3.0, mFC modification
+\ Max. 4GB no SDHC, access thru buffer 512B or short block or direct
+
+\ V.1.0, 16.07.2009, tested on atmega32, amforth30mFC12.zip
+\ - used SPI (MOSI, MISO, SCK, SS)
+\ mmc_init, mmc_CID, mmc_CSD, mmc_read, mmc_mread, mmc_write,
+\ mmc_blk@, mmc_blk!, mmc_c@, mmc_c!, mmc_end?, mmc_end!
+
+\ needs +/-spi for pin configuration
+\ needs +/-mmc for slave select action
+
+hex
+
+variable mmc_#buf \ position in buf
+variable mmc_buf 1FE allot \ 512B RAM
+
+
+ \ enable spi for mmc, set I/O
+: mmc_+spi ( -- )
+ +spi
+ -spi2x
+ SPCR_SPE SPCR_MSTR or
+ spi.f/128 or
+ spi.mode0 or SPCR c! ;
+
+ \ send dummy byte x-times
+: mmc_dummy ( x -- )
+ 0 ?do $ff c!spi loop ;
+
+
+\ convert 32b block to byte addr, double 9 lshift
+: mmc_blk2addr ( L H -- L H )
+ swap dup 9 lshift \ -- H L L<<9
+ swap 7 rshift \ -- H L<<9 L>>7
+ rot 9 lshift or ; \ -- L<<9 H<<9
+
+
+ \ waiting for cmd response
+: mmc_cresp ( -- c|-1 )
+ FF 0 do
+ c@spi dup 80 and 0= \ bit7=0?
+ if unloop exit then \ -- c, 0=ok
+ drop \ --
+ loop -1 ; \ -- -1, timeout
+
+
+ \ waiting for data response
+: mmc_dresp ( -- c|-1 )
+ FF 0 do
+ c@spi dup 11 and 1 = \ xxx0ccc1
+ if
+ 0F and unloop exit \ -- c, 5=ok
+ then
+ drop \ --
+ loop -1 ; \ -- -1, timeout
+
+
+ \ waiting for token
+: mmc_token ( -- c|-1 )
+ FF 0 do
+ c@spi dup FF - \ <>FF?
+ if unloop exit then \ -- c, FC,FE=ok
+ drop \ --
+ loop -1 ; \ -- -1, timeout
+
+
+ \ waiting while busy, after write
+: mmc_busy ( -- 0|-1 )
+ FF 0 do
+ c@spi FF = \ =FF?
+ if 0 unloop exit then \ -- 0, ok
+ loop -1 ; \ -- -1, timeout
+
+
+ \ send command cmd, data xl, xh
+: mmc_cmd ( xl xh cmd -- c|-1 )
+ FF c!spi \ flush spi register
+ 40 or c!spi \ send command cmd
+ dup >< c!spi c!spi \ send xhh, xhl
+ dup >< c!spi c!spi \ send xlh, xll
+ 95 c!spi \ no crc
+ mmc_cresp ; \ -- c|-1, c=0 no errors
+
+
+ \ set block length
+: mmc_length ( n -- c|-1 )
+ 0 10 mmc_cmd ; \ CMD16
+
+
+ \ stop multiread
+: mmc_rstop ( -- c|-1 )
+ 0 0 C mmc_cmd \ CMD12
+ mmc_busy or -mmc ; \ -- c|-1, c=0 no errors
+
+
+ \ stop multiwrite
+: mmc_wstop ( -- c|-1 )
+ FD c!spi \ Stop tran for CMD25
+ FF c!spi \ 1B wait
+ mmc_busy -mmc ; \ -- c|-1, c=0 no errors
+
+
+ \ reset card, idle
+: mmc_reset ( -- c|-1 )
+ -mmc 10 mmc_dummy \ 74< clk to reset mmc
+ +mmc
+ 0 0 0 mmc_cmd ; \ CMD0, -- 1, reset ok
+
+
+ \ detect sd card, 0=SD, -1=timeout
+: mmc_sd? ( -- c|-1 )
+ 0 0 37 mmc_cmd drop \ CMD55
+ 0 0 29 mmc_cmd \ ACMD41, -- c
+ dup 1+ \ -- -1 0, timeout
+ if 4 and then ; \ SD(R1.2=0) / MMC(R1.2=1)
+
+
+ \ wait for init MMC card
+: mmc_waitmmc ( -- 0|-1 )
+ FF \ -- cnt
+ begin
+ 0 0 1 mmc_cmd 0= \ CMD1, -- cnt f
+ if drop 0 exit then \ -- 0, ok
+ 1- dup 0= \ -- cnt-1 f
+ until 1- ; \ -- -1, timeout
+
+
+ \ wait for init SD card
+: mmc_waitsd ( -- 0|-1 )
+ FF \ -- cnt
+ begin
+ 0 0 37 mmc_cmd drop \ CMD55
+ 0 0 29 mmc_cmd 0= \ ACMD41, -- cnt f
+ if drop 0 exit then \ -- 0, ok
+ 1- dup 0= \ -- cnt-1 f
+ until 1- ; \ -- -1, timeout
+
+
+
+
+ \ check end of sector, for mmc read
+: mmc_end? ( -- flag )
+ 200 mmc_#buf @
+ > 0= dup \ -- c c, -1=end
+ if \ size<=#buf then
+ 2 mmc_dummy \ dummy crc
+ then ;
+
+
+\ check end of sector, wait for no busy, for mmc write
+: mmc_end! ( -- 0|-1 )
+ mmc_end? \ -- flag, crc dummy for end
+ if
+ mmc_dresp 5 <> \ -- 0, 0=ok, response
+ mmc_busy or \ -- c, 0=ok, writed
+ else 0 then ; \ -- c, 0=ok, -1=timeout
+
+
+: mmc_buf> ( addr n -- 0|-1 )
+ dup mmc_#buf +! \ +n, update buf position
+ 0 ?do \ addr n -- send n bytes from addr
+ dup c@ c!spi 1+ \ -- addr+1
+ loop drop
+ \ n!spi
+ mmc_end! ; \ -- c, 0=ok, -1=timeout
+
+
+ \ copy spi to buf
+: mmc_>buf ( addr n -- )
+ dup mmc_#buf +! \ +n, update buf position
+ 0 ?do \ write n bytes to addr
+ c@spi over c! 1+ \ -- addr+1
+ loop drop
+\ n@spi
+ mmc_end? drop ; \ crc dummy for end
+
+
+ \ wait for token, copy first n bytes to buf
+: mmc_(read) ( n 0 -- c|-1 )
+ 0 mmc_#buf ! \ reset buf position
+ dup 0= \ 0 -- , cmd ok
+ if
+ drop mmc_token dup \ c -- c c
+ FE =
+ if
+ drop mmc_buf swap \ -- addr n
+ mmc_>buf 0 \ -- 0, ok
+ else
+ swap drop \ n c -- c
+ then
+ else
+ swap drop \ n c -- c
+ then ; \ 0=ok, -1=timeout
+
+
+ \ copy first n bytes to card, response, busy
+: mmc_(write) ( n 0 -- c|-1 )
+ 0 mmc_#buf ! \ reset buf position
+ dup 0= \ 0 -- , cmd ok
+ if
+ drop FF c!spi \ wait 1B
+ FE c!spi \ send start byte
+ mmc_buf swap \ -- addr n
+ mmc_buf> \ -- c, 0=ok, -1=timeout
+ else
+ swap drop \ n c -- c
+ then ; \ 0=ok, -1=timeout
+
+
+ \ copy first n bytes to card, multiwrite, busy
+: mmc_(mwrite) ( n 0 -- c|-1 )
+ 0 mmc_#buf ! \ reset buf position
+ dup 0= \ 0 -- , cmd ok
+ if
+ drop FF c!spi \ wait 1B
+ FC c!spi \ send start byte
+ mmc_buf swap \ -- addr n
+ mmc_buf> \ -- c, 0=ok, -1=timeout
+ else
+ swap drop \ n c -- c
+ then ; \ 0=ok, -1=timeout
+
+
+\ ----- final words -----
+
+ \ initialize card MMC or SD v.1.x
+: mmc_init ( -- x|-1 )
+ 0 mmc_#buf !
+ mmc_+spi \ init spi, I/O
+ mmc_reset \ -- c, 1=ok
+ dup 1-
+ if -mmc 100 xor exit then \ <>1 then exit
+ drop \ --
+
+ mmc_sd? \ detect SD
+ dup 0< \ -- 0, SD
+ if -mmc 200 xor exit then \ -1 --, timeout
+ if
+ mmc_waitmmc \ MMC init
+ else
+ mmc_waitsd \ SD init
+ then
+ 200 mmc_length \ set sector length
+ or -mmc ; \ -- 0|-1, 0=ok, -1=timeout
+
+
+ \ read CID register 16B
+: mmc_CID ( -- c|-1 )
+ +mmc 10 \ length 16B
+ 0 0 A mmc_cmd \ CMD10,
+ mmc_(read) \ 10 c -- c, 0=ok, -1=timeout
+ 2 mmc_dummy \ dummy CRC
+ -mmc ;
+
+
+ \ read CSD register 16B
+: mmc_CSD ( -- c|-1 )
+ +mmc 10 \ length 16B
+ 0 0 9 mmc_cmd \ CMD9
+ mmc_(read) \ 10 c -- c, 0=ok, -1=timeout
+ 2 mmc_dummy \ dummy CRC
+ -mmc ;
+
+
+ \ open sector for read, copy n bytes to buf
+ \ 200 ABCD 7F mmc_read \ open,copy 512B from sector
+ \ 0 ABCD 7F mmc_read \ only open sector 7FABCD
+: mmc_read ( n xl xh -- c|-1 ) \ length, sector addr
+ +mmc
+ mmc_blk2addr \ addr*512, block->byte
+ 11 mmc_cmd \ addrL addrH 11 --, CMD17
+ mmc_(read) \ n c -- c, 0=ok, -1=timeout
+ -mmc ;
+
+
+ \ open sector for multi read, copy n bytes to buf
+: mmc_mread ( n xl xh -- c|-1 ) \ length, sector addr
+ +mmc
+ mmc_blk2addr \ addr*512, block->byte
+ 12 mmc_cmd \ addrL addrH 12 --, CMD18
+ mmc_(read) \ n c -- c, 0=ok, -1=timeout
+ -mmc ;
+
+
+ \ open sector for write, copy n bytes from buf to card
+: mmc_write ( n xl xh -- c|-1 ) \ length, sector addr
+ +mmc
+ mmc_blk2addr \ addr*512, block->byte
+ 18 mmc_cmd \ addrL addrH 18 --, CMD24
+ mmc_(write) \ n c -- c, 0=ok, -1=timeout
+ -mmc ;
+
+
+ \ open sector for multi write, copy n bytes from buf to card
+: mmc_mwrite ( n xl xh -- c|-1 ) \ length, sector addr
+ +mmc
+ mmc_blk2addr \ addr*512, block->byte
+ 19 mmc_cmd \ addrL addrH 19 --, CMD25
+ mmc_(mwrite) \ n c -- c, 0=ok, -1=timeout
+ -mmc ;
+
+
+ \ read short block from opened sector to buf
+ \ use mmc_read or mmc_(read) first
+: mmc_blk@ ( addr n -- ) \ addr, length of blk
+ +mmc
+ mmc_>buf \ addr n -- ,copy spi to buf
+ -mmc ;
+
+
+ \ write short block to opened sector from buf
+ \ use mmc_write or mmc_(write) first
+: mmc_blk! ( addr n -- 0|-1 ) \ addr, length of blk
+ +mmc
+ mmc_buf> \ addr n -- 0|-1, from buf
+ -mmc ; \ 0=ok, -1=timeout
+
+
+ \ direct read byte from opened sector
+ \ note: +mmc, if end of sector then dummy crc, -mmc
+: mmc_c@ ( -- c )
+ c@spi \ read byte from card
+ 1 mmc_#buf +! ; \ increment position
+
+
+ \ direct write byte to opened sector
+ \ note: +mmc, if end of sector then mmc_end!, -mmc
+: mmc_c! ( c -- )
+ c!spi \ write byte to card
+ 1 mmc_#buf +! ; \ increment position
+
+
+ \ view n bytes from mmc_buf+offset
+: mmc. ( n offset -- )
+ mmc_buf + swap
+ 0 ?do \ addr n -- view n bytes from addr
+ dup c@ . 1+ \ -- addr+1
+ loop drop ;
+
+
+\ sptx Stop transmit
+
+: mmc_tstmread ( n -- ) \ read n x 1MB
+ 0 .
+ 200 0 0 mmc_mread . \ open for multiread
+ +mmc
+ 0 ?do
+ 800 1 do \ 1MB
+ 200 0 mmc_(read) \ 512B
+ drop
+ loop
+ i .
+ loop 0 .
+ mmc_rstop drop ;
+
+
+: mmc_tstread ( n -- ) \ read n x 1MB
+ 0 .
+ 200 0 0 mmc_read .
+ 0 ?do
+ 800 1 do \ 1MB
+ 200 0 0 mmc_read \ 512B
+ drop
+ loop
+ i .
+ loop 0 . ;
+
+
+\ sptx Stop transmit
+
diff --git a/amforth-6.5/avr8/lib/hardware/mpc485.frt b/amforth-6.5/avr8/lib/hardware/mpc485.frt
new file mode 100644
index 0000000..811b9b3
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/mpc485.frt
@@ -0,0 +1,156 @@
+\ Multi-processor communication RS485 - Lubos Pekny, www.forth.cz
+\ Library for amforth 3.0, mFC modification
+
+\ V.1.0, 30.01.2009, tested on atmega32, amforth30mFC10.zip
+\ - used PD.7 for switch RX/TX RS485
+
+hex
+
+forth
+<bit> definitions \ into vocabulary <bit>
+
+\ usart i/o atmega32
+32 constant PORTD
+2B constant UCSRA
+2A constant UCSRB
+40 constant UCSRC
+
+forth
+<mpc> definitions \ into vocabulary <mpc>
+
+06 constant ACK
+15 constant NAK
+
+ \ wait for tx complete, rx ready
+: txc ( -- )
+ <bit>
+ begin PORTD @ 80 and 0= until ; \ wait for PD.7=0
+
+
+ \ initialize multi-processor communication 7-bit
+ \ modul is waiting for address, b7=1
+: +mpc7 ( -- )
+ <bit>
+ txc \ wait for tx complete
+ UCSRA c@ 01 or UCSRA c! \ MPCM=1, multiprocessor
+ 8C UCSRC c! ; \ UCSZ=10, no parity, 2 Stopbits
+
+
+ \ initialize no MPC communication 8-bit
+ \ modul receive/transmit 8-bit data, b7=0
+: -mpc7 ( -- )
+ <bit>
+ UCSRA c@ FE and UCSRA c! \ MPCM=0, no multiprocessor
+ 86 UCSRC c! ; \ UCSZ=11, no parity, 1 Stopbit
+
+
+ \ write ID to mpc_ID and eeprom 000C
+: mpc_ID! ( x -- )
+ dup 12 e! \ 16b to $0012:0013
+ mpc_ID c! ; \ 8b ID to RAM
+
+
+ \ send buffer+CR+crc if enabled
+ \ if n=0 then send CR only
+: mpc_sendbuf ( addr n -- )
+ dup 0= \ n=0?
+ if
+ drop drop 0D tx0 exit
+ then
+ begin
+ over over 0 \ -- addr n addr n 0
+ do
+ dup i + c@ tx0 \ send buffer
+ loop over \ -- addr n addr n
+ 0D tx0 \ send CR
+ crc \ -- c1 c2 c3 c4 flag
+ if
+ 4 0 do tx0 loop \ send crc4-1
+ rx0 \ wait for ack/nak
+ else
+ ACK
+ then
+ ACK =
+ until drop drop ; \ ACK or crc disabled
+
+
+ \ send ID, slave initialized for communication
+: mpc_call ( c -- ) \ ID
+ 0 tx0 \ delay
+ 80 or tx0 \ set 7.bit+ID, for slave
+ +mpc7 ; \ modul off, wait for ID
+
+
+ \ send command line for ID.slave
+: mpc_line ( c -- ) \ ID
+ mpc_call \ ID.slave
+ tib >in @ \ -- addr offs
+ swap over + \ -- offs addr+
+ #tib @ rot - \ -- addr+ n
+ -mpc7
+ mpc_sendbuf
+ 0 #tib ! ; \ stop interpret
+
+
+ \ terminal-char, text commands for slave
+ \ send char, until ESC
+: mpc_termc ( -- )
+ begin
+ rx0?
+ if rx0 emit then \ answer
+ key?
+ if
+ key dup tx0 \ send char
+ 1B =
+ else
+ 0
+ then
+ until ; \ until ESC pressed
+
+
+: ~end +mpc7 ;
+: ~call mpc_call ;
+: ~line mpc_line ;
+: ~id mpc_ID c@ ;
+
+
+ \ init mpc after restart, $14.7=1 then slave
+: appl_mpc ( -- )
+ applturnkey \ init vocabulary, ID, echo, antic
+ 14 e@ 80 and \ default echo b7=1 then slave, wait
+ if +mpc7 then ; \ ~end
+
+' appl_mpc 0A e! \ write appl_mpc to eeprom APPLTURNKEY
+
+\ echo c@ 80 or 14 e! \ set slave after restart
+\ echo c@ 7F and 14 e! \ set master, no wait
+
+\ ditx Disable transmit
+
+\ ----- Test -----
+\ master: PC, 8-bits data, bit 7 cleared
+\ two slaves: ID=2, ID=5
+\ slave ID5: 4 3 + 5
+\ slave ID2: +
+\ result: C
+\ +antic ~end modules are waiting
+\ alt+0133 send 128+5, select slave ID5
+\ !! wait line by line
+\ Forfiter: TestOK=Off, CRdelay=1000 or TestOK=On, F8-step by step
+\ if loop created then try backspace, enter or +crc ~end from editor
+
+~id . \ 5, view selected slave
+2 ~call \ switch to slave ID2
+~id . \ 2, this run on slave ID2
+5 ~line 4 3 + . cr ~end \ send line from slave ID2 to ID5
+ \ "5 ~line" run on slave ID2
+ \ "4 3 + . cr ~end" run on slave ID5
+ \ 7, store to slave ID2 TOS
+5 ~line ~id . cr ~end \ " ~id . cr ~end" run on slave ID5
+ \ 5, store to slave ID2 TOS
++ . \ C, run on slave ID2
+5 ~call \ switch to slave ID5, run on slave ID2
+~id . \ 5, run on slave ID5
+
+\ entx Enable transmit
+\ end of file
diff --git a/amforth-6.5/avr8/lib/hardware/spi.frt b/amforth-6.5/avr8/lib/hardware/spi.frt
new file mode 100644
index 0000000..49dbd19
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/spi.frt
@@ -0,0 +1,110 @@
+\ SPI routines
+
+\ requires: 2rvalue (with further deps)
+\ bitnames
+
+#require 2rvalue.frt
+#require bitnames.frt
+
+\ definitions from application, matching the
+\ SPI hardware pins
+\ PORTB 1 portpin: spi.clk
+\ PORTB 2 portpin: spi.mosi
+\ PORTB 3 portpin: spi.miso
+
+\ usage
+
+\ specific slave select pin
+\ PORTX PINY portpin: appl.ss_line
+\ appl.ss_line to spi.ss
+
+0. 2rvalue spi.ss
+
+\ update spi.ss to the actual setup
+\ +spi -- turn on SPI module, sets up the pins as well
+\ spi.modeX spi.setmode -- switch clock polarity/clock phase
+\ spi.f/X spi.setspeed -- select spi clock rate relative to f_cpu
+\ +spi.2x -- double speed
+\ -spi.2x -- normal speed
+\ -spi -- turn off SPI
+\
+
+\ following definitions are the same for all atmegas
+
+SPSR 0 portpin: spi.2x
+
+SPCR 6 portpin: spi.enable
+SPCR 5 portpin: spi.dord
+SPCR 4 portpin: spi.master
+SPCR %00001100 bitmask: spi.mode
+SPCR %00000011 bitmask: spi.speed
+
+$0 constant spi.mode0 \ sample rising/--
+$4 constant spi.mode1 \ --/sample falling
+$8 constant spi.mode2 \ sample falling/--
+$c constant spi.mode3 \ --/sample rising
+
+0 constant spi.f/4
+1 constant spi.f/16
+2 constant spi.f/64
+3 constant spi.f/128
+
+: +spi
+ \ Slave select *must* be *always* at a controlled level when SPI is activated.
+ \ Changing a pin into output mode change its level to low. that makes a SPI think
+ \ a communication has started which is not the case when this word is called.
+ spi.ss high \ deselect slave
+ spi.ss pin_output \ possibly short low pulse
+ spi.ss high \
+
+ \ now its save to turn on the SPI module
+ spi.master high
+ spi.enable high
+
+ \ since spi.ss is HIGH, nobody will be confused
+ spi.clk pin_output
+ spi.mosi pin_output
+ \ miso is controlled by SPI module internally
+;
+
+: -spi 0 SPCR c! ;
+
+\ check SPI device datasheet for mode settings
+: spi.setmode ( spi-mode -- )
+ spi.mode pin!
+;
+
+\ speed relative to f_cpu, constants see above
+: spi.setspeed ( spi.speed -- )
+ spi.speed pin!
+;
+
+\ double speed mode
+: +spi2x
+ spi.2x high
+;
+
+
+: -spi2x
+ spi.2x low
+;
+
+\ send a byte, ignore recieved byte
+: c!spi ( c -- )
+ c!@spi drop
+;
+
+ \ receive a byte, send a dummy one
+: c@spi ( -- c)
+ 0 c!@spi
+;
+
+\ send a cell, check data order for MSB/LSB
+\ untested so far
+: !@spi
+ dup >< ( -- low high )
+ spi.dord is_high? if swap then \ LSB first
+ c!@spi swap c!@spi
+ spi.dord is_low? if swap then \ MSB was first
+ >< or \ upper nibble is set to 0 automatically
+;
diff --git a/amforth-6.5/avr8/lib/hardware/timer0.frt b/amforth-6.5/avr8/lib/hardware/timer0.frt
new file mode 100644
index 0000000..29670e6
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/timer0.frt
@@ -0,0 +1,43 @@
+\ TIMER_0 example
+\
+\ requires
+\ in application master file
+\ .set WANT_TIMER_COUNTER_0 = 1
+\ from device.frt
+\ TIMER0_OVFAddr
+\ provides
+\ timer0.tick -- increasing ticker
+\
+\ older mcu's may need
+TCCR0 constant TCCR0B
+TIMSK constant TIMSK0
+
+variable timer0.tick
+
+: timer0.isr
+ 1 timer0.tick +!
+;
+
+\ preload for overflow interrupt every 1ms
+\ preload = 256 - (f_cpu / (prescaler * 1000))
+
+: timer0.preload
+ f_cpu #1000 um/mod nip 64 / 256 - negate
+;
+
+: timer0.init ( -- )
+ timer0.preload TCNT0 c!
+ 0 timer0.tick !
+ ['] timer0.isr TIMER0_OVFAddr int!
+;
+
+: timer0.start
+ timer0.init
+ %00000011 TCCR0B c! \ prescaler 64
+ %00000001 TIMSK0 c! \ enable overflow interrupt
+;
+
+: timer0.stop
+ %00000000 TCCR0B c! \ stop timer
+ %00000000 TIMSK0 c! \ stop interrupt
+;
diff --git a/amforth-6.5/avr8/lib/hardware/timer1.frt b/amforth-6.5/avr8/lib/hardware/timer1.frt
new file mode 100644
index 0000000..7ab9061
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/timer1.frt
@@ -0,0 +1,44 @@
+\ TIMER_1 example
+\
+\ requires
+\ in application master file
+\ .set WANT_TIMER_COUNTER_1 = 1
+\ from device.frt
+\ TIMER1_OVFAddr
+\ provides
+\ timer1.tick -- increasing ticker
+\
+\ older mcu's may need
+\ TCCR1 constant TCCR1B
+\ TIMSK constant TIMSK1
+
+variable timer1.tick
+
+: timer1.isr
+ 1 timer1.tick +!
+;
+
+\ preload for overflow interrupt every 1 ms
+\ preload = 65536 - (f_cpu / (prescaler * 1000))
+
+: timer1.preload
+ f_cpu #1000 um/mod nip 8 / negate
+;
+
+: timer1.init ( -- )
+ timer1.preload TCNT1 !
+ 0 timer1.tick !
+ ['] timer1.isr TIMER1_OVFAddr int!
+;
+
+: timer1.start
+ timer1.init
+ 0 timer1.tick !
+ %00000010 TCCR1B c! \ prescaler 8
+ %00000001 TIMSK1 c! \ enable overflow interrupt
+;
+
+: timer1.stop
+ %00000000 TCCR1B c! \ stop timer
+ %00000000 TIMSK1 c! \ stop interrupt
+;
diff --git a/amforth-6.5/avr8/lib/hardware/timer2.frt b/amforth-6.5/avr8/lib/hardware/timer2.frt
new file mode 100644
index 0000000..ed0472f
--- /dev/null
+++ b/amforth-6.5/avr8/lib/hardware/timer2.frt
@@ -0,0 +1,42 @@
+\ TIMER_2 example
+\ uses an external 32kHz clock quartz
+\ 32kHz / 256 => 128 ticks per second
+\ 7.8125 ms per tick (gets approximated)
+\ --> less accurate than the other timers, but...
+\
+\ 16 ticks are 125ms
+\ 125 = 15*8+5: 15x 8-tock and a short step
+\ or 125 = 15*7+20:15x 7-tock and a huge step
+\ -> we choose the 1st variant
+\ provides
+\ timer2.tick -- increasing ticker
+\
+
+variable timer2.tick
+variable timer2.tock \ used internally
+
+: timer2.isr ( -- )
+ timer2.tock @ 1+ 15 = if
+ 0 timer2.tock !
+ 5 timer2.tick +!
+ else
+ 8 timer2.tick +!
+ 1 timer2.tock +!
+ then
+;
+
+: timer2.init ( -- )
+ 1 TCCR2 c!
+ 8 ASSR c!
+ ['] timer2.isr TIMER2_OVFAddr int!
+;
+
+: timer2.start
+ 0 timer2.tick !
+ 0 timer2.tock !
+ TIMSK c@ $40 or TIMSK c! ( enable timer2 interupt )
+;
+
+: timer2.stop
+ TIMSK c@ [ $40 invert ] literal and TIMSK c! \ stop timer2 interrupt
+;
diff --git a/amforth-6.5/avr8/lib/imove.frt b/amforth-6.5/avr8/lib/imove.frt
new file mode 100644
index 0000000..bf33697
--- /dev/null
+++ b/amforth-6.5/avr8/lib/imove.frt
@@ -0,0 +1,12 @@
+\ copy a string from flash to RAM
+\
+\ i->d on the msp430, and the same stack as cmove
+\
+: imove ( i-addr len ram -- )
+ rot rot dup 1 and >r \ ( ram i-addr len ) ( r: odd )
+ 2/ over + dup >r \ ( ram i-addr i-addr' ) ( r: odd i-addr' )
+ swap \ ( ram i-addr' i-addr )
+ ?do i @i over ! cell+ loop \ ( ram' )
+ r> r> \ ( ram' i-addr' odd )
+ if @i swap c! else 2drop then
+;
diff --git a/amforth-6.5/avr8/lib/portio.frt b/amforth-6.5/avr8/lib/portio.frt
new file mode 100644
index 0000000..4d40c46
--- /dev/null
+++ b/amforth-6.5/avr8/lib/portio.frt
@@ -0,0 +1,46 @@
+\ Only for PORTx bits,
+\ because address of DDRx is one less than address of PORTx.
+
+\ Set DDRx so its corresponding pin is output.
+: pin_output ( pinmask portadr -- )
+ 1- bm:high
+;
+
+\ Set DDRx so its corresponding pin is input.
+: pin_input ( pinmask portadr -- )
+ 1- bm:low
+;
+
+\ PINx is two less of PORTx
+: pin_high? ( pinmask portaddr -- f)
+ 1- 1- c@ and
+;
+
+: pin_low? ( pinmask portaddr -- f)
+ 1- 1- c@ invert and
+;
+
+\ read the pins masked as input
+: pin@ ( pinmask portaddr -- c )
+ 1- 1- c@ and
+;
+
+\ toggle the pin
+: toggle ( pinmask portaddr -- )
+ 2dup bm:high? if
+ bm:low
+ else
+ bm:high
+ then
+;
+
+\ disable the pull up resistor
+: pin_pullup_off ( pinmask portaddr -- )
+ 2dup pin_input low
+;
+
+
+\ enable the pull up resistor
+: pin_pullup_on ( pinmask portaddr -- )
+ 2dup pin_input high
+;
diff --git a/amforth-6.5/avr8/lib/ram.frt b/amforth-6.5/avr8/lib/ram.frt
new file mode 100644
index 0000000..fb37ab7
--- /dev/null
+++ b/amforth-6.5/avr8/lib/ram.frt
@@ -0,0 +1,225 @@
+\ RAM - 512kB sram memory, Lubos Pekny, www.forth.cz
+\ Library for amforth 3.0, mFC modification
+\ ram_init, ram_addr, ram_addr+, ram_read, ram_write, ram_off
+\ ram_c@, ram_c!, ram_c@+, ram_c!+
+
+\ V.1.1, 28.07.2009, asm optimalization, amforth30mFC12.zip
+\ V.1.0, 20.03.2009, tested on atmega32, amforth30mFC11.zip
+\ - used bitnames.frt
+\ - used PA0-7, PB0-2, PC2-7
+
+hex
+
+forth
+<bit> definitions \ into vocabulary <bit>
+
+3B constant PORTA \ ATmega32
+\ 38 constant PORTB
+\ 35 constant PORTC
+
+
+forth
+<ram> definitions \ into vocabulary <ram>
+
+<bit>
+PORTC 02 portpin: ram_WRL \ PC.2 set low 8b addr
+PORTC 03 portpin: ram_WRH \ PC.3 set high 8b addr
+PORTC 04 portpin: ram_INC \ PC.4 increment addr
+PORTC 05 portpin: ram_WR \ PC.5 write to sram
+PORTC 06 portpin: ram_OE \ PC.6 output enable
+PORTC 07 portpin: ram_CS \ PC.7 chip select
+PORTA constant ram_DATA \ PA data 8b, in/out
+: ram_PAGE <bit> 07 PORTB ; \ PB.0-2 out
+: ram_CTRL <bit> FC PORTC ; \ PC.2-7 out
+
+ \ define macros
+: ram_din,
+ assembler
+ R16 0 ldi,
+ ram_DATA 1- R16 sts, ;
+
+: ram_dout,
+ assembler
+ R16 FF ldi,
+ ram_DATA 1- R16 sts, ;
+
+
+ \ data port direction - input
+code ram_din ( -- )
+ ram_din,
+end-code
+
+
+ \ data port direction - output
+code ram_dout ( -- )
+ ram_dout,
+end-code
+
+
+ \ set I/O
+: ram_init ( -- )
+ <bit>
+ -jtag \ port C i/o
+ ram_din \ port in
+ ram_PAGE pin_output \ out
+ ram_CTRL pin_output \ out
+ ram_PAGE high \ last page
+ ram_CTRL high ; \ sram disabled
+
+
+ \ set low 8b addr
+code ram_addrl ( c -- )
+ ram_DATA TOSL sts, \ data
+ loadtos, \ delete c
+ <bit>
+ ram_WRL low,
+ ram_WRL high, \ set counter
+end-code
+
+
+ \ set high 8b addr
+code ram_addrh ( c -- )
+ ram_DATA TOSL sts, \ data
+ loadtos, \ delete c
+ <bit>
+ ram_WRH low,
+ ram_WRH high, \ set counter
+end-code
+
+
+ \ set addr, sram off, port input
+: ram_addr ( addr page -- )
+ <bit>
+ ram_CS high \ sram disabled
+ ram_PAGE pin! \ set page
+ ram_dout \ port out
+ dup ram_addrl \ addr low
+ >< ram_addrh \ addr high
+ ram_din ; \ port in
+
+
+ \ increment addr
+code ram_addr+ ( -- )
+ <bit>
+ ram_INC low,
+ ram_INC high, \ increment addr
+end-code
+
+
+ \ set pins for read from sram
+code ram_read ( -- )
+ <bit>
+ ram_din, \ port in
+ ram_OE low,
+ ram_CS low, \ out and chip enabled
+end-code
+
+
+ \ set pins for write to sram
+code ram_write ( -- )
+ <bit>
+ ram_OE high,
+ ram_CS low, \ chip enabled
+ ram_dout, \ port out
+end-code
+
+
+ \ set pins for disable sram
+code ram_off ( -- )
+ <bit>
+ ram_CS high,
+ ram_OE high, \ sram disabled
+ ram_din, \ port in
+end-code
+
+
+ \ write pulse
+code ram_clk ( -- )
+ <bit>
+ ram_WR low,
+ ram_WR high, \ write to sram
+end-code
+
+
+ \ read from sram
+: ram_c@ ( -- c )
+ ram_read \ sram enabled, out
+ [ ram_DATA 1- 1- ] \ convert to literal
+ literal c@ \ read byte from sram
+ ram_off ;
+
+
+ \ write to sram
+: ram_c! ( c -- )
+ ram_write \ sram enabled, in
+ ram_DATA c! \ write byte to sram
+ ram_clk \ write pulse
+ ram_off ;
+
+
+ \ read from sram, increment addr, page 64kB
+ \ use ram_read ram_c@+ .... ram_off
+code ram_c@+ ( -- c )
+ \ ram_DATA 1- 1- c@
+ savetos, \ add item
+ TOSL ram_DATA 1- 1- lds, \ port -> tosl
+ TOSH 0 ldi, \ 0 -> tosh
+
+ \ ram_addr+
+ ram_INC <bit> ma2pbi \ mask addr -- port bit
+ over over \ 2dup
+ assembler
+ cbi, nop, sbi, \ pulse INC
+end-code
+
+
+ \ write to sram, increment addr, page 64kB
+ \ use ram_write ram_c!+ .... ram_off
+code ram_c!+ ( c -- )
+ \ ram_DATA c!
+ ram_DATA TOSL sts, \ c!, tosl -> port
+ loadtos, \ delete item
+
+ \ ram_clk
+ ram_WR <bit> ma2pbi \ mask addr -- port bit
+ over over \ 2dup
+ assembler
+ cbi, nop, sbi, \ pulse WR
+
+ \ ram_addr+
+ ram_INC <bit> ma2pbi \ mask addr -- port bit
+ over over \ 2dup
+ assembler
+ cbi, nop, sbi, \ pulse INC
+end-code
+
+
+\ sptx Stop transmit
+
+\ ----- Test -----
+forth
+<ram>
+ram_init
+13 3 0 ram_addr ram_c! \ 13 write at addr 0003, page 0
+14 4 0 ram_addr ram_c! \ 14 write at addr 0004, page 0
+
+0 0 ram_addr \ set addr to 0:0000
+ram_write \ mode write
+31 ram_c!+
+32 ram_c!+
+33 ram_c!+ \ write 31,32,33 from addr 0:0000
+
+0 0 ram_addr \ set addr to 0:0000
+ram_read \ mode read
+ram_c@+ .
+ram_c@+ .
+ram_c@+ . \ read 31,32,33 from addr 0:0000
+ram_c@+ .
+ram_c@+ . \ read 13,14
+ram_off
+
+4 0 ram_addr ram_c@ . \ read 14 at addr 0:0004
+2 0 ram_addr ram_c@ . \ read 33 at addr 0:0002
+3 0 ram_addr ram_c@ . \ read 13 at addr 0:0003
+
+\ end of file
diff --git a/amforth-6.5/avr8/lib/recognizer-arch.frt b/amforth-6.5/avr8/lib/recognizer-arch.frt
new file mode 100644
index 0000000..9f8cb52
--- /dev/null
+++ b/amforth-6.5/avr8/lib/recognizer-arch.frt
@@ -0,0 +1,8 @@
+\ platform specific core
+
+\ #require eallot.frt
+
+: recognizer ( size -- stack-id )
+ \ allocate size + 1 cells in config space (eeprom, info flash)
+ 1+ cells ehere swap eallot dup 0 !e
+;
diff --git a/amforth-6.5/avr8/lib/run-hayes.frt b/amforth-6.5/avr8/lib/run-hayes.frt
new file mode 100644
index 0000000..20442a5
--- /dev/null
+++ b/amforth-6.5/avr8/lib/run-hayes.frt
@@ -0,0 +1,28 @@
+\
+\ process this file with amforth-upload.py and
+\ the proper setting of $AMFORTH_LIB (basedir of
+\ you amforth file tree)
+\ WIN (untested, DOS Box)
+\ cd c:\amforth-x.y
+\ set AMFORTH_LIB=c:\amforth-x.y
+\ python tools\amforth-upload.py -t com1: examples\run-hayes.frt
+\ UNIX / MAC (Terminal)
+\ cd $HOME/amforth-x.y
+\ export AMFORTH_LIB=$HOME/amforth-x.y
+\ tools/amforth-upload.py -t /dev/ttyUSB0 examples/run-hayes.frt
+\ enjoy!
+\
+\ it is meant to be run on a newly flashed
+\ controller, e.g. all the dict_* are included
+\
+
+#require is.frt
+
+\ include all sources
+#include core.frt
+#include double.frt
+#include marker.frt
+#include tester-amforth.frt
+\ and finally run all the tests
+
+#include core.fr