From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- 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 ++ 14 files changed, 1789 insertions(+) create mode 100644 amforth-6.5/avr8/lib/hardware/25xxx.frt create mode 100644 amforth-6.5/avr8/lib/hardware/flash-block.frt create mode 100644 amforth-6.5/avr8/lib/hardware/i2c-twi-master.frt create mode 100644 amforth-6.5/avr8/lib/hardware/i2c-twi-slave.frt create mode 100644 amforth-6.5/avr8/lib/hardware/int-q.frt create mode 100644 amforth-6.5/avr8/lib/hardware/interrupts.frt create mode 100644 amforth-6.5/avr8/lib/hardware/key2char.frt create mode 100644 amforth-6.5/avr8/lib/hardware/keyboard.frt create mode 100644 amforth-6.5/avr8/lib/hardware/mmc.frt create mode 100644 amforth-6.5/avr8/lib/hardware/mpc485.frt create mode 100644 amforth-6.5/avr8/lib/hardware/spi.frt create mode 100644 amforth-6.5/avr8/lib/hardware/timer0.frt create mode 100644 amforth-6.5/avr8/lib/hardware/timer1.frt create mode 100644 amforth-6.5/avr8/lib/hardware/timer2.frt (limited to 'amforth-6.5/avr8/lib/hardware') 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 + 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 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 + 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 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 +; -- cgit v1.2.3