From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- amforth-6.5/avr8/lib/2evalue.frt | 30 -- amforth-6.5/avr8/lib/assembler-test.frt | 58 --- amforth-6.5/avr8/lib/assembler.frt | 325 -------------- amforth-6.5/avr8/lib/bitnames-code.frt | 351 --------------- amforth-6.5/avr8/lib/bitnames.frt | 155 ------- amforth-6.5/avr8/lib/calc-baudrate.frt | 12 - amforth-6.5/avr8/lib/dot-res.frt | 19 - amforth-6.5/avr8/lib/eallot.frt | 5 - amforth-6.5/avr8/lib/forth2012/core-ext.frt | 13 - .../avr8/lib/forth2012/core-ext/avr-defers.frt | 20 - .../avr8/lib/forth2012/core-ext/marker-test.frt | 18 - amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt | 23 - amforth-6.5/avr8/lib/forth2012/core.frt | 26 -- amforth-6.5/avr8/lib/forth2012/core/align.frt | 3 - amforth-6.5/avr8/lib/forth2012/core/aligned.frt | 3 - amforth-6.5/avr8/lib/forth2012/core/avr-values.frt | 11 - amforth-6.5/avr8/lib/forth2012/core/c-comma.frt | 3 - .../avr8/lib/forth2012/core/eeprom-buffer.frt | 15 - .../avr8/lib/forth2012/core/environment-q.frt | 53 --- amforth-6.5/avr8/lib/forth2012/core/evaluate.frt | 46 -- .../avr8/lib/forth2012/core/fm-slash-mod.frt | 22 - .../avr8/lib/forth2012/core/sm-slash-rem.frt | 8 - .../avr8/lib/forth2012/core/star-slash-mod.frt | 4 - amforth-6.5/avr8/lib/hardware/25xxx.frt | 131 ------ amforth-6.5/avr8/lib/hardware/flash-block.frt | 37 -- amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt | 136 ------ amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt | 89 ---- amforth-6.5/avr8/lib/hardware/int-q.frt | 2 - amforth-6.5/avr8/lib/hardware/interrupts.frt | 7 - amforth-6.5/avr8/lib/hardware/key2char.frt | 135 ------ amforth-6.5/avr8/lib/hardware/keyboard.frt | 486 --------------------- amforth-6.5/avr8/lib/hardware/mmc.frt | 371 ---------------- amforth-6.5/avr8/lib/hardware/mpc485.frt | 156 ------- amforth-6.5/avr8/lib/hardware/spi.frt | 110 ----- amforth-6.5/avr8/lib/hardware/timer0.frt | 43 -- amforth-6.5/avr8/lib/hardware/timer1.frt | 44 -- amforth-6.5/avr8/lib/hardware/timer2.frt | 42 -- amforth-6.5/avr8/lib/imove.frt | 12 - amforth-6.5/avr8/lib/portio.frt | 46 -- amforth-6.5/avr8/lib/ram.frt | 225 ---------- amforth-6.5/avr8/lib/recognizer-arch.frt | 8 - amforth-6.5/avr8/lib/run-hayes.frt | 28 -- 42 files changed, 3331 deletions(-) delete mode 100644 amforth-6.5/avr8/lib/2evalue.frt delete mode 100644 amforth-6.5/avr8/lib/assembler-test.frt delete mode 100644 amforth-6.5/avr8/lib/assembler.frt delete mode 100644 amforth-6.5/avr8/lib/bitnames-code.frt delete mode 100644 amforth-6.5/avr8/lib/bitnames.frt delete mode 100644 amforth-6.5/avr8/lib/calc-baudrate.frt delete mode 100644 amforth-6.5/avr8/lib/dot-res.frt delete mode 100644 amforth-6.5/avr8/lib/eallot.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core-ext.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/align.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/aligned.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/avr-values.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/c-comma.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/environment-q.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/evaluate.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt delete mode 100644 amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/25xxx.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/flash-block.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/int-q.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/interrupts.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/key2char.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/keyboard.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/mmc.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/mpc485.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/spi.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/timer0.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/timer1.frt delete mode 100644 amforth-6.5/avr8/lib/hardware/timer2.frt delete mode 100644 amforth-6.5/avr8/lib/imove.frt delete mode 100644 amforth-6.5/avr8/lib/portio.frt delete mode 100644 amforth-6.5/avr8/lib/ram.frt delete mode 100644 amforth-6.5/avr8/lib/recognizer-arch.frt delete mode 100644 amforth-6.5/avr8/lib/run-hayes.frt (limited to 'amforth-6.5/avr8/lib') diff --git a/amforth-6.5/avr8/lib/2evalue.frt b/amforth-6.5/avr8/lib/2evalue.frt deleted file mode 100644 index 6a1d3aa..0000000 --- a/amforth-6.5/avr8/lib/2evalue.frt +++ /dev/null @@ -1,30 +0,0 @@ -\ 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 deleted file mode 100644 index b769f3d..0000000 --- a/amforth-6.5/avr8/lib/assembler-test.frt +++ /dev/null @@ -1,58 +0,0 @@ -\ ----- 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, - 0 jmp, \ -+ -\ label> \ | +>-+ -\ clc, \ | | | -\ adr> rjmp, \ | | +-+ -\ nop, \ | | | -\ brcc, \ | | +-+ -\ nop, \ | | | -\ rot | | -\ swap 0 jmp, 0 >lbl \ addr->lbl[0] -\ label> 1 >lbl -\ clc, -\ adr> rjmp, 2 >lbl -\ nop, -\ 2 brcc, 3 >lbl -\ nop, -\ 0 tos -\ 1 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, ......... ( -- adr ) \ label> ......... ......... 0 jmp, - - - \ Addr, for jump forward, adr> brne, adr> 0 jmp, -: adr> ( -- adr k ) - dp 0 ; - - - \ Label for branch forward, adr> brne, ......... rjmp, ......... 0 jmp, ......... lbl ( addr c -- ) \ index c=0..9 - 2* (lbl) + ! ; - - \ read addr from vector of labels -: pulse ( turn portD pin #7 for 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 deleted file mode 100644 index fdda840..0000000 --- a/amforth-6.5/avr8/lib/bitnames.frt +++ /dev/null @@ -1,155 +0,0 @@ -\ 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 pulse ( turn portD pin #7 for 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 ) - - 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 deleted file mode 100644 index 015eb10..0000000 --- a/amforth-6.5/avr8/lib/calc-baudrate.frt +++ /dev/null @@ -1,12 +0,0 @@ - -\ 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 deleted file mode 100644 index 398bd88..0000000 --- a/amforth-6.5/avr8/lib/dot-res.frt +++ /dev/null @@ -1,19 +0,0 @@ - -\ 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 deleted file mode 100644 index 73939cc..0000000 --- a/amforth-6.5/avr8/lib/eallot.frt +++ /dev/null @@ -1,5 +0,0 @@ -\ 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 deleted file mode 100644 index 7e16121..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core-ext.frt +++ /dev/null @@ -1,13 +0,0 @@ -\ '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 deleted file mode 100644 index 0421ab3..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core-ext/avr-defers.frt +++ /dev/null @@ -1,20 +0,0 @@ -\ 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 deleted file mode 100644 index 3a7c9b0..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core-ext/marker-test.frt +++ /dev/null @@ -1,18 +0,0 @@ -#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 deleted file mode 100644 index 8d5756b..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core-ext/marker.frt +++ /dev/null @@ -1,23 +0,0 @@ -\ 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 deleted file mode 100644 index 5db1994..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core.frt +++ /dev/null @@ -1,26 +0,0 @@ -\ '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 deleted file mode 100644 index e68f679..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/align.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 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 deleted file mode 100644 index f2b942a..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/aligned.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 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 deleted file mode 100644 index a23d0be..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/avr-values.frt +++ /dev/null @@ -1,11 +0,0 @@ - - -\ 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 deleted file mode 100644 index 2c4e678..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/c-comma.frt +++ /dev/null @@ -1,3 +0,0 @@ -\ 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 deleted file mode 100644 index 5cb2ceb..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/eeprom-buffer.frt +++ /dev/null @@ -1,15 +0,0 @@ -\ 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 deleted file mode 100644 index e16428d..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/environment-q.frt +++ /dev/null @@ -1,53 +0,0 @@ -\ 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 deleted file mode 100644 index 80659bc..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/evaluate.frt +++ /dev/null @@ -1,46 +0,0 @@ -\ 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 deleted file mode 100644 index dfb10e9..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/fm-slash-mod.frt +++ /dev/null @@ -1,22 +0,0 @@ - - -: 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 deleted file mode 100644 index baf07cf..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/sm-slash-rem.frt +++ /dev/null @@ -1,8 +0,0 @@ - -: 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 deleted file mode 100644 index 9d47a61..0000000 --- a/amforth-6.5/avr8/lib/forth2012/core/star-slash-mod.frt +++ /dev/null @@ -1,4 +0,0 @@ - -\ #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 deleted file mode 100644 index 2951810..0000000 --- a/amforth-6.5/avr8/lib/hardware/25xxx.frt +++ /dev/null @@ -1,131 +0,0 @@ - - 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 deleted file mode 100644 index 661e3b4..0000000 --- a/amforth-6.5/avr8/lib/hardware/flash-block.frt +++ /dev/null @@ -1,37 +0,0 @@ -\ -\ 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 deleted file mode 100644 index 3bd2190..0000000 --- a/amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt +++ /dev/null @@ -1,136 +0,0 @@ -\ 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 deleted file mode 100644 index c045433..0000000 --- a/amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt +++ /dev/null @@ -1,89 +0,0 @@ -\ 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 deleted file mode 100644 index 923e000..0000000 --- a/amforth-6.5/avr8/lib/hardware/int-q.frt +++ /dev/null @@ -1,2 +0,0 @@ - -: 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 deleted file mode 100644 index d6eae22..0000000 --- a/amforth-6.5/avr8/lib/hardware/interrupts.frt +++ /dev/null @@ -1,7 +0,0 @@ -\ 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 deleted file mode 100644 index 37e3d45..0000000 --- a/amforth-6.5/avr8/lib/hardware/key2char.frt +++ /dev/null @@ -1,135 +0,0 @@ -\ 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 deleted file mode 100644 index 7182f26..0000000 --- a/amforth-6.5/avr8/lib/hardware/keyboard.frt +++ /dev/null @@ -1,486 +0,0 @@ -\ 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 - definitions \ into vocabulary - -38 constant PORTB \ Atmega32, PB.2 (INT2)<-clk, PB.1 (in)<-data out - -forth - definitions \ into vocabulary - -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 - 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, - =0B then 0B - adr> brcs, - R18 0B ldi, - 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 rcall, 7 >lbl \ set flag EXTEND or RELEAS - -\ --- End --- - 3 \ from Set err - ZL pop, ZH pop, - R16 pop, R17 pop, - R18 pop, 3F R18 out, - R18 pop, - reti, - -\ --- Set err --- - 2 brcc, \ >=F0 - ZH K-EXTEND-MASK >< ori, - ZH ZH cpse, - < ori, - kbd_FLGR 1+ ZH sts, \ update final flags - ret, - - -\ Make work flags, Caps, LShift, RShift, etc. - 5 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 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 - < 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 ( -- ) - - -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 - - 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 - - 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 deleted file mode 100644 index f213c9b..0000000 --- a/amforth-6.5/avr8/lib/hardware/mmc.frt +++ /dev/null @@ -1,371 +0,0 @@ -\ 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 deleted file mode 100644 index 811b9b3..0000000 --- a/amforth-6.5/avr8/lib/hardware/mpc485.frt +++ /dev/null @@ -1,156 +0,0 @@ -\ 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 - definitions \ into vocabulary - -\ usart i/o atmega32 -32 constant PORTD -2B constant UCSRA -2A constant UCSRB -40 constant UCSRC - -forth - definitions \ into vocabulary - -06 constant ACK -15 constant NAK - - \ wait for tx complete, rx ready -: txc ( -- ) - - 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 ( -- ) - - 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 ( -- ) - - 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 deleted file mode 100644 index 49dbd19..0000000 --- a/amforth-6.5/avr8/lib/hardware/spi.frt +++ /dev/null @@ -1,110 +0,0 @@ -\ 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 deleted file mode 100644 index 29670e6..0000000 --- a/amforth-6.5/avr8/lib/hardware/timer0.frt +++ /dev/null @@ -1,43 +0,0 @@ -\ 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 deleted file mode 100644 index 7ab9061..0000000 --- a/amforth-6.5/avr8/lib/hardware/timer1.frt +++ /dev/null @@ -1,44 +0,0 @@ -\ 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 deleted file mode 100644 index ed0472f..0000000 --- a/amforth-6.5/avr8/lib/hardware/timer2.frt +++ /dev/null @@ -1,42 +0,0 @@ -\ 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 deleted file mode 100644 index bf33697..0000000 --- a/amforth-6.5/avr8/lib/imove.frt +++ /dev/null @@ -1,12 +0,0 @@ -\ 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 deleted file mode 100644 index 4d40c46..0000000 --- a/amforth-6.5/avr8/lib/portio.frt +++ /dev/null @@ -1,46 +0,0 @@ -\ 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 deleted file mode 100644 index fb37ab7..0000000 --- a/amforth-6.5/avr8/lib/ram.frt +++ /dev/null @@ -1,225 +0,0 @@ -\ 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 - definitions \ into vocabulary - -3B constant PORTA \ ATmega32 -\ 38 constant PORTB -\ 35 constant PORTC - - -forth - definitions \ into vocabulary - - -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 07 PORTB ; \ PB.0-2 out -: ram_CTRL 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 ( -- ) - - -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 - - 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 - - ram_WRH low, - ram_WRH high, \ set counter -end-code - - - \ set addr, sram off, port input -: ram_addr ( addr page -- ) - - 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+ ( -- ) - - ram_INC low, - ram_INC high, \ increment addr -end-code - - - \ set pins for read from sram -code ram_read ( -- ) - - 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 ( -- ) - - ram_OE high, - ram_CS low, \ chip enabled - ram_dout, \ port out -end-code - - - \ set pins for disable sram -code ram_off ( -- ) - - ram_CS high, - ram_OE high, \ sram disabled - ram_din, \ port in -end-code - - - \ write pulse -code ram_clk ( -- ) - - 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 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 ma2pbi \ mask addr -- port bit - over over \ 2dup - assembler - cbi, nop, sbi, \ pulse WR - - \ ram_addr+ - ram_INC ma2pbi \ mask addr -- port bit - over over \ 2dup - assembler - cbi, nop, sbi, \ pulse INC -end-code - - -\ sptx Stop transmit - -\ ----- Test ----- -forth - -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 deleted file mode 100644 index 9f8cb52..0000000 --- a/amforth-6.5/avr8/lib/recognizer-arch.frt +++ /dev/null @@ -1,8 +0,0 @@ -\ 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 deleted file mode 100644 index 20442a5..0000000 --- a/amforth-6.5/avr8/lib/run-hayes.frt +++ /dev/null @@ -1,28 +0,0 @@ -\ -\ 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 -- cgit v1.2.3