aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/lib/hardware
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
commit67d25d837ac55f28a366c0a3b262e439a6e75fc3 (patch)
treedf7715c7724c5935ab87c807f3b8b4ef529315e3 /amforth-6.5/avr8/lib/hardware
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/avr8/lib/hardware')
-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
14 files changed, 1789 insertions, 0 deletions
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
+;