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/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 deletions(-) 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 (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 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 -; -- cgit v1.2.3