From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- .../common/lib/hardware/1wire-crc8-test.frt | 54 +++++ amforth-6.5/common/lib/hardware/1wire-crc8.frt | 65 ++++++ amforth-6.5/common/lib/hardware/1wire-ds18s20.frt | 32 +++ amforth-6.5/common/lib/hardware/1wire.frt | 222 +++++++++++++++++++++ amforth-6.5/common/lib/hardware/date-time.frt | 29 +++ amforth-6.5/common/lib/hardware/i2c-compass.frt | 49 +++++ amforth-6.5/common/lib/hardware/i2c-detect.frt | 40 ++++ .../common/lib/hardware/i2c-eeprom-block.frt | 77 +++++++ .../common/lib/hardware/i2c-eeprom-value.frt | 19 ++ amforth-6.5/common/lib/hardware/i2c-eeprom.frt | 47 +++++ amforth-6.5/common/lib/hardware/i2c-lcd.frt | 31 +++ amforth-6.5/common/lib/hardware/i2c-value.frt | 23 +++ amforth-6.5/common/lib/hardware/i2c.frt | 87 ++++++++ .../common/lib/hardware/int-critical-test.frt | 14 ++ amforth-6.5/common/lib/hardware/int-critical.frt | 12 ++ amforth-6.5/common/lib/hardware/mmc-test.frt | 96 +++++++++ amforth-6.5/common/lib/hardware/power-save.frt | 36 ++++ amforth-6.5/common/lib/hardware/spi-mmc.frt | 98 +++++++++ amforth-6.5/common/lib/hardware/timer-test.frt | 22 ++ amforth-6.5/common/lib/hardware/timer.frt | 56 ++++++ amforth-6.5/common/lib/hardware/vt100.frt | 59 ++++++ amforth-6.5/common/lib/hardware/xonxoff.frt | 27 +++ 22 files changed, 1195 insertions(+) create mode 100644 amforth-6.5/common/lib/hardware/1wire-crc8-test.frt create mode 100644 amforth-6.5/common/lib/hardware/1wire-crc8.frt create mode 100644 amforth-6.5/common/lib/hardware/1wire-ds18s20.frt create mode 100644 amforth-6.5/common/lib/hardware/1wire.frt create mode 100644 amforth-6.5/common/lib/hardware/date-time.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-compass.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-detect.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-eeprom.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-lcd.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c-value.frt create mode 100644 amforth-6.5/common/lib/hardware/i2c.frt create mode 100644 amforth-6.5/common/lib/hardware/int-critical-test.frt create mode 100644 amforth-6.5/common/lib/hardware/int-critical.frt create mode 100644 amforth-6.5/common/lib/hardware/mmc-test.frt create mode 100644 amforth-6.5/common/lib/hardware/power-save.frt create mode 100644 amforth-6.5/common/lib/hardware/spi-mmc.frt create mode 100644 amforth-6.5/common/lib/hardware/timer-test.frt create mode 100644 amforth-6.5/common/lib/hardware/timer.frt create mode 100644 amforth-6.5/common/lib/hardware/vt100.frt create mode 100644 amforth-6.5/common/lib/hardware/xonxoff.frt (limited to 'amforth-6.5/common/lib/hardware') diff --git a/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt b/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt new file mode 100644 index 0000000..1c628d6 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/1wire-crc8-test.frt @@ -0,0 +1,54 @@ +\ 2013-01-21 EW + +marker --start-- + +include ewlib/1wire_crc8.fs + +\ testdata from Dallas Application Note 27 +\ A2 00 00 00 01 B8 1C 02 +\ ^^crc fam.code^^ + +: run_test + $A2 \ crc + $00 $00 $00 $01 $B8 $1C $02 \ rom id + #7 \ N + .s + 1w.crc8? if + ." crc ok" + else + ." crc error" + then + cr + $A2 1+ \ WRONG CRC! + $00 $00 $00 $01 $B8 $1C $02 \ rom id + #7 \ N + .s + 1w.crc8? if + ." crc ok" + else + ." crc error" + then + cr + + \ reverse test + $02 $1C $B8 $01 $00 $00 $00 $A2 + #7 .s + 1w.crc8.rev? if + ." crc ok" + else + ." crc error" + then + cr + + $02 $1C $B8 $01 $00 $00 $00 $A2 1+ \ WRONG CRC! + #7 .s + 1w.crc8.rev? if + ." crc ok" + else + ." crc error" + then + cr + + +; + diff --git a/amforth-6.5/common/lib/hardware/1wire-crc8.frt b/amforth-6.5/common/lib/hardware/1wire-crc8.frt new file mode 100644 index 0000000..e727ac7 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/1wire-crc8.frt @@ -0,0 +1,65 @@ +\ 2013-01-21 EW ewlib/1wire_crc8.fs +\ 1wire 8bit crc check, as used by ds18s20 +\ based on C code by Colin O'Flynn and M.Thomas, found at +\ http://www.siwawi.arubi.uni-kl.de/avr_projects/tempsensor/ds18x20_demo_20110209.zip + + +$18 constant 1w.crc8.polynom +variable 1w.crc.shreg \ crc shift register +variable 1w.crc.byte \ current input byte +variable 1w.crc.fbit \ feedbackbit + +\ process 1 bit from input +: ((1w.crc8)) + 1w.crc.shreg @ 1w.crc.byte @ xor $01 and + dup 1w.crc.fbit ! + if \ fbit set + 1w.crc.shreg @ 1w.crc8.polynom xor + 1w.crc.shreg ! + then + 1w.crc.shreg @ 1 rshift $7f and + 1w.crc.shreg ! + 1w.crc.fbit @ if + 1w.crc.shreg @ $80 or + 1w.crc.shreg ! + then +; +\ process 1 byte of input +: (1w.crc8) ( x -- ) + ( tos ) 1w.crc.byte ! + 8 0 do + ((1w.crc8)) + 1w.crc.byte @ 1 rshift + 1w.crc.byte ! + loop +; + +\ process N bytes from stack, leave crc +: 1w.crc8 ( xN-1 .. x0 N -- crc ) + 0 1w.crc.shreg ! + 0 1w.crc.byte ! + 0 1w.crc.fbit ! + 0 ?do + (1w.crc8) + loop + 1w.crc.shreg @ +; +\ process N bytes from stack, compare with crc, leave flag +: 1w.crc8? ( crc xN-1 .. x0 N -- t/f ) + 1w.crc8 = +; + +\ same as 1w.crc8, but process data in reverse (stack) order! +: 1w.crc8.rev ( x0 .. xN-1 N -- crc ) + 0 1w.crc.shreg ! + 0 1w.crc.byte ! + 0 1w.crc.fbit ! + 1 over ?do i pick (1w.crc8) -1 +loop + 0 ?do drop loop + 1w.crc.shreg @ +; +: 1w.crc8.rev? ( x0 .. xN-1 crc N -- t/f ) + swap >r \ save crc + 1w.crc8.rev + r> = +; diff --git a/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt b/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt new file mode 100644 index 0000000..95be0c1 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/1wire-ds18s20.frt @@ -0,0 +1,32 @@ +\ 2009-12-23 EW ewlib/1w_ds18s20.fs +\ 2013-01-13 ported to amforth-5.0 + +\ --- Fam.10 DS18S20 thermometer ----------------------------- + +\ conversion + warten ist schon rum! +: 1w.rd.T ( addr[8] -- x1=Tl x2=Th x3 .. x9=crc ) + 1w.reset drop \ fixme: if ... then + \ device addressieren + 1w.cmd.matchrom &9 >1w + 1w.cmd.readdata &1 >1w + &9 <1w +; + +\ convert answer to physical units 1/100 C +: ds18s20.decode ( x1 .. x9=crc -- T*100 ok ) + 7 0 do drop loop \ ignore crc + 8 lshift + \ combine T_h T_l + &100 &2 */ \ scale + 0 \ ok, because we ignore crc +; +: ds18s20.decode.check ( x1 .. x9=crc -- T*100 ok=0 | error=1 ) + 7 pick >r 8 pick >r \ save data + 8 1w.crc8.rev? if \ crc good? + r> r> 8 lshift + + &100 &2 */ + 0 \ ok + else + r> r> drop drop + 1 \ error + then +; \ No newline at end of file diff --git a/amforth-6.5/common/lib/hardware/1wire.frt b/amforth-6.5/common/lib/hardware/1wire.frt new file mode 100644 index 0000000..6d96759 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/1wire.frt @@ -0,0 +1,222 @@ +\ Adapted from 4e4th: +\ all relevant words are lowercase. +\ romid is now a forth 2012 buffer. +\ assembly part rewritten from scratch +\ renamed to file extension frt +\ requires buffer: +\ NAME +\ 1wire.frt +\ SYNOPSIS +\ Example high-level Forth functions for Dallas 1-wire devices +\ DESCRIPTION +\ +\ USES +\ Uses the following kernel functions (provided by 1wire.asm) +\ 1W.RESET [ -- f ] Initialize 1-wire devices; return true if present +\ 1W.SLOT [ c -- c' ] Write and read one bit to/from 1-wire. +\ +\ COPYRIGHT +\ [c] 2012 Bradford J. Rodriguez. +\ +\ This program is free software; you can redistribute it and/or modify +\ it under the terms of the GNU General Public License as published by +\ the Free Software Foundation; either version 3 of the License, or +\ [at your option] any later version. +\ +\ This program is distributed in the hope that it will be useful, +\ but WITHOUT ANY WARRANTY; without even the implied warranty of +\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +\ GNU General Public License for more details. +\ +\ You should have received a copy of the GNU General Public License +\ along with this program. If not, see . +\ +\ Commercial inquiries should be directed to the author at +\ 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada +\ or via email to bj@camelforth.com +\ ****** + + +\ Basic 1-wire operations +\ 1W.TOUCH ( c1 -- c2 ) Write and read one byte to/from 1-wire bus. +\ This implements the "touch byte" function described in Dallas +\ Application Note 74. It expects a byte c1 which is sent over the +\ 1-wire bus. To perform a read operation, this must be FF hex. +\ The returned byte c2 is the data read back from the bus. For a +\ read operation, this is the read data; for a write operation, this +\ has no significance and can be discarded. +\ +\ C!1W ( c -- ) Write one byte to the 1-wire bus. +\ This uses 1W.TOUCH to write one byte of data. The value returned +\ by 1W.TOUCH is discarded. +\ +\ C@1W ( -- c ) Read one byte from the 1-wire bus. +\ This uses 1W.TOUCH with an input parameter of FF hex to read one +\ byte from a 1-wire device. +\ + +\ #include buffer.frt + +: 1w.touch ( c1 -- c2 ) + 1w.slot 1w.slot 1w.slot 1w.slot + 1w.slot 1w.slot 1w.slot 1w.slot ; + +: c!1w ( c -- ) 1w.touch drop ; +: c@1w ( -- c ) $ff 1w.touch ; +: n>1w ( xN .. x1 N -- ) 0 ?do c!1w loop ; +: n<1w ( N -- x1 .. xN ) 0 ?do c@1w loop ; + +\ SHOWID should be used ONLY if there is a single 1-wire device attached. +: 1w.showid + 1w.reset if base @ hex + $33 c!1w + c@1w . c@1w . c@1w . c@1w . + c@1w . c@1w . c@1w . c@1w . + base ! + then ; + +\ Maxim 1-wire ROM Search algorithm +\ per AN937 "Book of iButton Standards", figure 5-3 + +variable lastdisc ( used as byte variable ) +lastdisc 1+ constant doneflag ( used as byte variable ) + +variable rombit ( used as byte variable, 1..64 ) +rombit 1+ constant discmark ( used as byte variable ) + +8 buffer: romid ( 8 byte array ) + +: !rombit ( f -- ) + rombit c@ 1- 8 /mod ( -- f bit# byte# ) + romid + ( -- f bit# addr ) + 1 rot lshift ( -- f addr bitmask ) + rot if ( f true, set bit ) + over c@ or swap c! + else ( f false, clear bit ) + invert over c@ and swap c! + then +; + +: @rombit ( -- f ) + rombit c@ 1- 8 /mod ( -- bit# byte# ) + romid + c@ ( -- bit# byte ) + 1 rot lshift ( -- byte bitmask ) + and +; + +: newsearch 0 lastdisc ! ; ( clear LASTDISC and DONEFLAG ) + +: romsearch ( -- f ) ( Returns 0 or 1 ) + 0 ( default return value ) + doneflag c@ if + 0 doneflag c! + exit + then + 1w.reset if ( presence signal detected? ) + + 1 rombit c! ( yes: set ROM bit index to 1 ) + 0 discmark c! ( set discrepancy marker to 0 ) + $f0 c!1w ( send search command on bus ) + begin + $03 1w.slot 1w.slot ( read two bits: ba000000 ) + dup $c0 = if ( bitA = bitB = 1?) + drop + 0 lastdisc c! + exit + else dup 0= if ( bitA = bitB = 0?) + drop + rombit c@ lastdisc c@ = if + 1 !rombit + else rombit c@ lastdisc c@ > if + 0 !rombit + rombit c@ discmark c! + else @rombit 0= if + rombit c@ discmark c! + then then then + else + $40 and ( bit A value ) + !rombit + then then + @rombit if 1 else 0 then 1w.slot drop ( send ROM bit to bus ) + rombit c@ 1+ dup rombit c! + $40 > until + discmark c@ dup lastdisc c! + 0= if + 1 doneflag c! + else + drop 1 ( set return value to true ) + then + + else ( no presence signal ) + 0 lastdisc c! + then +; + +\ Demonstrates how to use ROMSEARCH to find all attached devices ) + +: 1w.scan ( -- ) + 1w.reset if ( presence signal detected? ) + base @ hex + newsearch + begin + romsearch + romid 8 + romid do i c@ 3 u.r loop cr + 0= until + cr base ! + then +; + +\ 1w.current is the device the host is currently +\ communicating with. +8 buffer: 1w.current + +\ define a 1wire device. At compile time +\ take 8 numbers from the stack, at runtime +\ copy these numbers to owcurrent and give +\ this address back to the caller +\ e.g. +\ > hex 1w.scan +\ 28 4C 75 CC 2 0 0 CD +\ ok +\ > 28 4C 75 CC 2 0 0 CD 1w.device: sensor1 +\ > sensor1 ( -- addr) +\ note that the byte order is the same that +\ 1w.scan prints, your numbers will be different. +: 1w.device: + ( n1 .. n8 -- ) + create + , , , , , , , , + does> + ( -- n1 .. n8 ) + 8 bounds do + i @i + loop ; + +\ Start an addressed command. This sends RESET, Match ROM [55h], +\ and the 8 bytes of ROMID. It should be followed by a DS18B20 +\ function command. + +: 1w.matchrom ( rom-id -- ) + 1w.reset if + $55 c!1w ( send Match ROM command ) + 8 0 do c!1w loop ( send 8 id bytes ) + else ." failed" drop then +; + +: 1w.skiprom ( -- ) + 1w.reset if + $cc c!1w + then +; + +\ Function commands that address a single device. +\ They require either a 1w.skiprom to talk to the +\ only device present on the bus or 1w.matchrom with +\ a specific ROM-ID to activate a specific one. + +: 1w.dumpscratch ( -- ) ( display 9 bytes of scratchpad ) + $BE c!1w + c@1w . c@1w . c@1w . c@1w . + c@1w . c@1w . c@1w . c@1w . + c@1w . +; diff --git a/amforth-6.5/common/lib/hardware/date-time.frt b/amforth-6.5/common/lib/hardware/date-time.frt new file mode 100644 index 0000000..13e5d25 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/date-time.frt @@ -0,0 +1,29 @@ + +\ create task space +$20 $20 0 task: t:date&time + +variable seconds +\ runs every second +: job-date&time + 1 seconds +! + \ more code for minute/hour/day... + 0 \ flag for an endless loop +; + +\ set up the task +: setup-date&time + t:date&time task-init \ create TCB in RAM + 0 seconds ! \ more code for minutes etc + t:date&time tcb>tid activate + \ code from here is executed as task, later on + ['] job-date&time every-second +; + +\ setup and start the task "date/time" +: turnkey-date&time + onlytask \ set up multitasker + 6 timer0.init timer0.start \ 16 MHz quartz + \ insert task into task list + setup-date&time t:date&time tcb>tid alsotask + multi \ start multitasking +; diff --git a/amforth-6.5/common/lib/hardware/i2c-compass.frt b/amforth-6.5/common/lib/hardware/i2c-compass.frt new file mode 100644 index 0000000..daa6380 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-compass.frt @@ -0,0 +1,49 @@ +\ +\ compass module mmc2120 (memsic) +\ hwid is always $30 +\ provides: +\ +\ i2c.compass.get ( -- status X Y) +\ X and Y are around 2000 (raw data) +\ status is 0 if no error occured + +\ dechiffer of the raw data: +\ according to http://www.aurob.com/?p=467 +\ interpolate linearly +\ x=map(1900,2188,-180,180) +\ y=map(1910,2193,-180,180) +\ grad=atan2(x,y)*180/pi + +#require i2c.frt +#require ms.frt + +$30 constant i2c.compass + +\ internal commands +: i2c.compass.setcoil + %00000010 0 2 i2c.compass i2c.n! +; +: i2c.compass.resetcoil + %00000100 0 2 i2c.compass i2c.n! +; + +: i2c.compass.measure + %00000001 0 2 i2c.compass i2c.n! +; + +: i2c.compass.fetchdata ( -- status x y ) + 5 0 i2c.compass i2c.n@ + ( -- status msb-x lsb-x msb-y lsb-y) + swap >< or $fff and >r \ Y + swap >< or $fff and r> \ X +; + +\ get the raw data from the module +\ the numbers for X/Y are usually around 2000. +\ status is 0 if everything is ok +: i2c.compass.get ( -- status x y ) + i2c.compass.resetcoil 1ms + i2c.compass.setcoil 5 ms + i2c.compass.measure 5 ms + i2c.compass.fetchdata +; diff --git a/amforth-6.5/common/lib/hardware/i2c-detect.frt b/amforth-6.5/common/lib/hardware/i2c-detect.frt new file mode 100644 index 0000000..6bd7fe4 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-detect.frt @@ -0,0 +1,40 @@ +\ detect presence of all possible devices on I2C bus +\ only the 7 bit address schema is supported + +\ not all bitpatterns are valid 7bit i2c addresses +: i2c.7bitaddr? ( a -- f) $7 $78 within ; + +: i2c.detect ( -- ) + base @ hex + \ header line + 4 spaces $10 0 do i 3 .r loop + $80 0 do + i $0f and 0= if + cr i 2 .r [char] : emit space + then + i i2c.7bitaddr? if + i i2c.ping? if \ does device respond? + i 3 .r + else + ." --" + then + else + ." " + then + loop + cr base ! +; + +\ output looks like +\ (ATmega1280)> i2c.detect +\ 0 1 2 3 4 5 6 7 8 9 A B C D E F +\ 0: -- -- -- -- -- -- -- -- -- +\ 10: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 20: -- -- -- -- -- -- -- 27 -- -- -- -- -- -- -- -- +\ 30: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 40: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 50: 50 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 60: -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +\ 70: -- -- -- -- -- -- -- -- +\ ok +\ diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt new file mode 100644 index 0000000..22351fb --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt @@ -0,0 +1,77 @@ +\ +\ I2C EEPROM driver for BLOCK wordset +\ +\ call i2c.ee.blockinit to activate the driver +\ for the BLOCK words. + +#require blocks.frt +#require bounds.frt +#require i2c-eeprom.frt +#require ms.frt + +\ select a eeprom module. +\ the pages differ in size. +\ do not overrun them +#16 constant 24c08 +#16 constant 24c16 +#32 constant 24c32 +#32 constant 24c64 +#64 constant 24c128 +#64 constant 24c256 +#128 constant 24c512 +#256 constant 24c1024 + +\ runtime configurable parameters, taken from or +\ calculated in i2c.ee.blockinit. Never change them directly +variable i2c.ee.hwid +variable i2c.ee.pagesize +variable i2c.ee.pages/block + +: i2c.ee.read-page ( addr len page hwid -- ) + dup i2c.begin + swap i2c.ee.pagesize @ * i2c.ee.send-addr + i2c.restart \ repeated start + i2c.rd i2c.tx + 1- bounds over >r ?do i2c.rx i c! loop + i2c.rxn r> c! \ last byte + i2c.end +; + +: i2c.ee.load-buffer ( a-addr u -- ) \ BLOCK API + 1- i2c.ee.pages/block @ * \ start address + i2c.ee.pages/block @ bounds ?do + dup i2c.ee.pagesize @ i i2c.ee.hwid @ i2c.ee.read-page + i2c.ee.pagesize @ + + loop drop +; + +: i2c.ee.write-page ( addr len page hwid -- ) + i2c.begin + i2c.ee.pagesize @ * i2c.ee.send-addr + bounds ?do i c@ i2c.tx loop + i2c.end 5 ms \ make sure the eeprom gets ready again +; + +: i2c.ee.save-buffer ( a-addr u -- ) \ BLOCK API + 1- i2c.ee.pages/block @ * \ start address + i2c.ee.pages/block @ bounds ?do + dup i2c.ee.pagesize @ i i2c.ee.hwid @ i2c.ee.write-page + i2c.ee.pagesize @ + + loop drop +; + +\ adjust the page size and update the #pages per block buffer +: i2c.ee.setpagesize ( 24cxx -- ) + blocksize over / i2c.ee.pages/block ! + i2c.ee.pagesize ! +; + +\ for turnkey +\ does not initialize TWI/I2C interface! (i2c.init.default) +: i2c.ee.blockinit ( pagesize hwid -- ) + block:init + ['] i2c.ee.load-buffer is load-buffer + ['] i2c.ee.save-buffer is save-buffer + i2c.ee.hwid ! + i2c.ee.setpagesize +; diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt new file mode 100644 index 0000000..50f0941 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt @@ -0,0 +1,19 @@ +\ +\ A value stored in I2C EEPROM. +\ + +#require value.frt +#require quotations.frt +#require ms.frt +#require i2c-eeprom.frt + +\ initial addr hwid ... +\ 17 0 $50 i2c.value "name" +: i2c.ee.value ( n addr hwid -- ) + (value) + over , \ store the addr + [: dup @i ( addr ) swap 3 + @i ( hwid) @i2c.ee ;] , + [: dup @i ( addr ) swap 3 + @i ( hwid) !i2c.ee 5 ms ;] , + dup , \ store hwid + !i2c.ee \ store inital data +; diff --git a/amforth-6.5/common/lib/hardware/i2c-eeprom.frt b/amforth-6.5/common/lib/hardware/i2c-eeprom.frt new file mode 100644 index 0000000..7468933 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-eeprom.frt @@ -0,0 +1,47 @@ +\ +\ Basic Access to I2C EEPROM +\ +\ useful words are +\ [ยข]@i2c.ee/[c]!i2c.ee +\ See cookbook for further information + +#require i2c.frt + +: i2c.ee.send-addr ( n -- ) + dup >< i2c.tx ( high byte ) i2c.tx ( low byte ) + \ no stop condition +; + +\ The write methods do not wait afterwards! +\ at least 5ms have to pass +: c!i2c.ee ( c addr hwid -- ) + i2c.begin + i2c.ee.send-addr + i2c.tx + i2c.end +; + +: !i2c.ee ( c addr hwid -- ) + i2c.begin + i2c.ee.send-addr + dup >< i2c.tx i2c.tx + i2c.end +; + +: c@i2c.ee ( addr hwid -- c ) + dup i2c.begin + swap i2c.ee.send-addr + i2c.start \ repeated start + i2c.rd i2c.tx \ hwid for reading + i2c.rx + i2c.end +; + +: @i2c.ee ( addr hwid -- n ) + dup i2c.begin + swap i2c.ee.send-addr + i2c.start \ repeated start + i2c.rd i2c.tx \ hwid for reading + i2c.rx >< i2c.rxn or + i2c.end +; diff --git a/amforth-6.5/common/lib/hardware/i2c-lcd.frt b/amforth-6.5/common/lib/hardware/i2c-lcd.frt new file mode 100644 index 0000000..b404f21 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-lcd.frt @@ -0,0 +1,31 @@ + +\ #require i2c-pe.frt + +$27 Evalue i2c.lcd.hwid + +%00010000 Evalue lcd.En \ enable bit +%00100000 Evalue lcd.Rw \ read/write bit +%01000000 Evalue lcd.Rs \ register select bit + +: i2c.lcd.pulse ( n -- ) + dup lcd.En or i2c.pe.c! + lcd.En invert and i2c.pe.c! +; + +: i2c.lcd.!4bit ( n -- ) + dup i2c.pe.c! + i2c.lcd.pulse +; + +: i2c.lcd.send ( c mode -- ) + >r dup >< $0f and r@ or i2c.lcd.!4bit ( high ) + $0f and r> or i2c.lcd.!4bit ( low ) +; + +: i2c.lcd.cmd ( c -- ) + 0 i2c.lcd.send +; + +: i2c.lcd.write ( c -- ) + lcd.Rs i2c.lcd.send +; diff --git a/amforth-6.5/common/lib/hardware/i2c-value.frt b/amforth-6.5/common/lib/hardware/i2c-value.frt new file mode 100644 index 0000000..7638be6 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c-value.frt @@ -0,0 +1,23 @@ +\ +\ an I2C value +\ + +#require values.frt +#require quotations.frt +#require i2c.frt + +\ initial hwid ... +\ 17 $3D i2c.cvalue "name" +: i2c.cvalue ( n addr hwid -- ) + (value) + dup , \ store the hwid + [: dup @i ( hwid) i2c.c@ ;] , + [: dup @i ( hwid) i2c.c! ;] , + i2c.c! \ store inital data +; + +\ use case: port extender +\ $ff $3d i2c.cvalue keys +\ $00 to keys ( turn all off ) +\ keys $01 and if ( if key 1 is pressed ) +\ diff --git a/amforth-6.5/common/lib/hardware/i2c.frt b/amforth-6.5/common/lib/hardware/i2c.frt new file mode 100644 index 0000000..8941c5f --- /dev/null +++ b/amforth-6.5/common/lib/hardware/i2c.frt @@ -0,0 +1,87 @@ +\ basic I2C operations, uses 7bit bus addresses +\ uses the TWI module of the Atmega's. +\ #require builds.frt +\ #require bitnames.frt + +\ low level driver words +\ #require i2c-twi-master.frt + +\ provides public commands + +\ i2c.begin -- starts a I2C bus cycle +\ i2c.end -- ends a I2C bus cycle +\ the following operation use a complete bus cycle +\ i2c.c! -- send one byte +\ i2c.c@ -- read one byte +\ i2c.n! -- send n bytes to device +\ i2c.n@ -- read n bytes from device +\ i2c.m!n@ -- first send m bytes, than read n bytes + +\ convert the bus address into a sendable byte +\ the address bits are the upper 7 ones, +\ the LSB is the read/write bit. + +: i2c.wr 2* ; +: i2c.rd 2* 1+ ; + +\ aquire the bus and select a device +\ start a write transaction +: i2c.begin ( hwid -- ) + dup i2c.current ! + i2c.start i2c.wr i2c.tx +; + +\ start a read transaction +: i2c.begin-read ( hwid -- ) + dup i2c.current ! + i2c.start i2c.rd i2c.tx +; + +\ release the bus and deselect the device +: i2c.end ( -- ) + i2c.stop + 0 i2c.current ! +; + +\ tranfser data from/to data stack + +\ fetch a byte from the device +: i2c.c@ ( hwid -- c ) + i2c.begin-read + i2c.rxn + i2c.end +; + +\ store a byte to a device +: i2c.c! ( c hwid -- ) + i2c.begin + i2c.tx + i2c.end +; + +\ send n bytes to device +: i2c.n! ( xn .. x1 N hwid -- ) + i2c.begin + 0 ?do \ uses N + i2c.tx \ send x1 ... xn + loop + i2c.end +; + +\ get n bytes from device +: i2c.n@ ( n hwid -- x1 .. xn ) + i2c.begin-read + 1- 0 max 0 ?do i2c.rx loop i2c.rxn + i2c.end +; + +\ complex and flexible transaction word +\ send m bytes x1..xm and fetch n bytes y1..yn afterwards +: i2c.m!n@ ( n xm .. x1 m hwid -- x1 .. xn ) + dup >r i2c.begin + 0 ?do i2c.tx loop \ send m bytes + i2c.restart \ repeated start + r> i2c.rd i2c.tx \ re-send addr, switch to read mode + 1- 0 max 0 ?do i2c.rx loop i2c.rxn \ read x1 .. xn + i2c.end +; diff --git a/amforth-6.5/common/lib/hardware/int-critical-test.frt b/amforth-6.5/common/lib/hardware/int-critical-test.frt new file mode 100644 index 0000000..ac07fe7 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/int-critical-test.frt @@ -0,0 +1,14 @@ + +\ #require int-critical.frt + +: bar ." bar" int? . ; +: baz ." baz" int? . ; +: qux ." qux" int? . ; + +: foo + bar + critical[ + \ nothing will disturb us here + baz + ]critical \ now interrupts or other things may happen again + qux ; diff --git a/amforth-6.5/common/lib/hardware/int-critical.frt b/amforth-6.5/common/lib/hardware/int-critical.frt new file mode 100644 index 0000000..d3bbf7f --- /dev/null +++ b/amforth-6.5/common/lib/hardware/int-critical.frt @@ -0,0 +1,12 @@ + +\ include mcu specific file +\ #require int-q.frt + +: critical[ + r> int? >r >r \ keep the current state + -int +; + +: ]critical + r> r> if +int then >r \ will crash if not matched +; diff --git a/amforth-6.5/common/lib/hardware/mmc-test.frt b/amforth-6.5/common/lib/hardware/mmc-test.frt new file mode 100644 index 0000000..b69fd90 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/mmc-test.frt @@ -0,0 +1,96 @@ +\ 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! + +hex + +\ ----- Test ----- + +mmc_init . \ init card +mmc_CID . 10 0 mmc. \ view 16B of mmc_buf +mmc_CSD . 10 0 mmc. + + +\ read +200 1234 0 mmc_read . \ read 512B from sect. 0:1234 +200 0 mmc. \ view buf + + +\ open+read, short block +100 1234 0 mmc_read . \ open sector 0:1234, read 256B +mmc_buf 100 + 100 mmc_blk@ \ read 256B, buf+offset 256B +200 0 mmc. \ view buf + + +\ open, short block +0 1234 0 mmc_read . \ open sector 0:1234 +mmc_buf 100 + 100 mmc_blk@ \ read 256B, buf+offset 256B +mmc_buf 100 mmc_blk@ \ read 256B, switched 256B +200 0 mmc. \ view buf + + +\ open, direct byte access +0 1234 0 mmc_read . \ open sector 0:1234 ++mmc +mmc_c@ . mmc_c@ . \ read 2 bytes from sector +1FE mmc_dummy \ read other 510 bytes +1FE mmc_#buf +! \ update counter +mmc_end? . \ if end of sector then crc dummy +-mmc + + +\ multiread +200 1234 0 mmc_mread . \ open,read 512B from sect. 1234 +200 0 mmc. \ view buf ++mmc +200 0 mmc_(read) . \ read 512B from sect. 1235 +200 0 mmc. \ view buf +200 0 mmc_(read) . \ read 512B from sect. 1236 +200 0 mmc. \ view buf +mmc_rstop . \ stop and -mmc + + +\ write +200 1234 0 mmc_read . +200 0 mmc. +ABBA mmc_buf ! \ change 2 bytes in buf +200 1234 0 mmc_write . \ write 512B to addr. 1234 +200 1234 0 mmc_read . +200 0 mmc. + + +\ open+write, short block +ACCA mmc_buf ! \ change 2 bytes in buf +ADDA mmc_buf 100 + ! \ change 2 bytes in buf +100 1234 0 mmc_write . \ open sector 1234, write 256B +mmc_buf 100 + 100 mmc_blk! . \ write 256B, buf+offset 256B +200 1234 0 mmc_read . +200 0 mmc. + + +\ open, direct byte access +0 1234 0 mmc_write . ++mmc +AE mmc_c! EA mmc_c! \ write 2 bytes to sector +1FE mmc_dummy \ write FF, 510x +1FE mmc_#buf +! \ update counter +mmc_end! . \ if end then wait while busy +-mmc +200 1234 0 mmc_read . +200 0 mmc. + + +\ multiwrite +ABCD mmc_buf ! +200 1234 0 mmc_mwrite . \ open,write 512B to sect. 1234 ++mmc +200 0 mmc_(mwrite) . \ write 512B to sect. 1235 +200 0 mmc_(mwrite) . \ write 512B to sect. 1236 +mmc_wstop . \ stop and -mmc + +\ end of file diff --git a/amforth-6.5/common/lib/hardware/power-save.frt b/amforth-6.5/common/lib/hardware/power-save.frt new file mode 100644 index 0000000..36e729f --- /dev/null +++ b/amforth-6.5/common/lib/hardware/power-save.frt @@ -0,0 +1,36 @@ + +\ fixme: currently the controller sleep too often +\ that breaks the poll based emit almost completely +\ either use the interrupt based emit or include an +\ empty timer task that wakes the controller up +\ +: idle + begin + $0 sleep \ save power, returns on interrupt + pause \ give cpu away + again +; + +$20 $20 0 task: idle-task + +: start-idle-task + idle-task tcb>tid + activate \ words after this line are run in new task + idle +; + +: starttasker + idle-task task-init \ create TCB in RAM + start-idle-task \ activate tasks job + + onlytask \ make cmd loop task-1 + idle-task tcb>tid alsotask \ start task-2 + multi \ activate multitasking +; +: run-turnkey + applturnkey + init + starttasker +; + +\ ' run-turnkey is turnkey \ make run-turnkey start on power up diff --git a/amforth-6.5/common/lib/hardware/spi-mmc.frt b/amforth-6.5/common/lib/hardware/spi-mmc.frt new file mode 100644 index 0000000..7513e58 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/spi-mmc.frt @@ -0,0 +1,98 @@ + + +: spi.init ( -- ) + +spi + spi.mode0 spi.setmode + -spi2x +; + +: spi.mmc.dummy ( x -- ) + 0 ?do $ff c!spi loop +; + +: spi.mmc.init ( -- ) + sd.init + spi.init + $11 spi.sd.dummy +; + +\ every command has 48 bits=6bytes +: mmc.cmd ( n1 n2 ... n6 -- ) + -mmc 20 ms \ de-select the card + $FF c!spi \ some random bits + +mmc 20 ms \ re-select the card + $40 or \ set bit 6 if the first byte assuming bit7 is 0 + &6 0 do c!spi loop ; \ send 48bits + + +\ response actions +\ there are different resonses: r1, r2, r3, r7 +\ r1 is the single byte response ( 0 means no error) +\ 0 b6 b5 b4 b3 b2 b1 b0 +\ | | | | | | | +\ | | | | | | In idle state +\ | | | | | Erase Reset +\ | | | | Illegal Command +\ | | | Command CRC error +\ | | Erase Sequence Error +\ | Address Error +\ Parameter Error + +\ 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 + +: R1 ( -- f ) + mmc.cresp +; + +: cmd0 ( -- f ) $95 0 0 0 0 0 mmc.cmd R1 1 = ; \ GO_IDLE_STATE - reset +: cmd1 ( -- f ) $ff 0 0 0 0 1 mmc.cmd R1 0= ; \ SEND_OP_COND init +: cmd16 ( -- ) $FF 0 0 2 0 16 mmc.cmd R1 drop ; \ SET_BLOCKLEN default 512 + +\ waiting for data token + +: mmc.wait_data_token ( -- f ) 0 16 0 do c@spi $FE = if drop true leave then loop ; + +\ read CSD and CID into a 16 byte buffer +16 buffer: mmc.infoblock + +: mmc.readblock ( addr len -- ) + mmc.wait_data_token + if + bounds do c@spi i c! loop + else abort" Could not read MMC data block" + then ; + +: cmd9 ( -- ) $ff 0 0 0 0 9 mmc.cmd R1 mmc.infoblock 16 mmc.readblock ; \ SEND_CSD +: cmd10 ( -- ) $ff 0 0 0 0 10 mmc.cmd R1 mmc.infoblock 16 mmc.readblock ; \ SEND_CID + +\ READ SINGLE BLOCK +: cmd17 ( addr n -- f ) + >r $ff ( CRC ) r> s>d 17 mmc.cmd R1 mmc.readblock ; + +: mmc.writeblock ( addr len -- ) + mmc.wait_data_token + if + bounds do i c@ c!spi loop + else abort" Could not write MMC data block" + then ; + +\ WRITE SINGLE BLOCK (n=512 bytes) +: cmd24 ( addr n -- f ) + >r $ff ( CRC ) r> s>d 24 mmc.cmd R1 mmc.writeblock ; diff --git a/amforth-6.5/common/lib/hardware/timer-test.frt b/amforth-6.5/common/lib/hardware/timer-test.frt new file mode 100644 index 0000000..7092892 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/timer-test.frt @@ -0,0 +1,22 @@ +\ test routines for timer + +\ prints the tick value every second (or so) +\ until a key is pressed. Usage: +\ ' test-every-second every-second +: test-every-second + @tick u. key? +; + +\ runs a single word n-times. prints the milliseconds +\ for the whole run +\ usage +\ ' foo 10 benchme +\ executes too 10 times and prints the elapsed time + +: benchme ( xt n -- ) + dup >r + @tick >r + 0 ?do dup execute loop drop + @tick r> - + cr r> u. ." iterations in " u. ." ms" cr +; diff --git a/amforth-6.5/common/lib/hardware/timer.frt b/amforth-6.5/common/lib/hardware/timer.frt new file mode 100644 index 0000000..5e73b6e --- /dev/null +++ b/amforth-6.5/common/lib/hardware/timer.frt @@ -0,0 +1,56 @@ +\ generic timer routines, based +\ upon hardware modules. + +\ requires +\ timer0.frt OR timer1.frt +\ provides +\ expired? -- checks whether a counter has expired +\ elapsed -- get the elapsed time in ms +\ after -- execute a word after n ms after now +\ ms -- alternative implementation for ANS94 ms +\ every -- runs a word every cycle. the word provides an exit flag +\ every-second -- runs a word every second +\ +: @tick + timer0.tick @ + \ timer1.tick @ + \ timer2.tick @ +; + +\ a timer is generally a timer tick number. +\ the actual meaning is either the start time +\ or the desired end time. All math is done +\ using unsigned numbers. The maximum interval +\ is 65.535 seconds (little more then a minute) + +\ check if the the timer t has expired +: expired? ( t -- flag ) + pause @tick - 0> invert +; + +\ alternative implementation for ms +: ms @tick + begin dup expired? until drop ; + +\ get the elapsed time since t +: elapsed ( t -- n ) + @tick swap - +; + +\ execute the word after u milliseconds +\ ex: ' foo 10 after +: after ( xt u -- ) + ms execute +; + +\ execute a word every u ms. The word +\ has the stack effect ( -- f). If f is +\ false, the loop ends +: every ( xt u -- ) + begin over over after until drop drop +; + +\ +: every-second ( xt -- ) + 1000 every +; + diff --git a/amforth-6.5/common/lib/hardware/vt100.frt b/amforth-6.5/common/lib/hardware/vt100.frt new file mode 100644 index 0000000..ca84bd6 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/vt100.frt @@ -0,0 +1,59 @@ +\ ansi terminal codes + +: ESC[ #27 emit [char] ] emit ; + +\ some helper words: print a number *without* +\ leading space in decimal +: .n base @ swap decimal 0 u.r base ! ; +: .;n [char] ; emit .n ; +: ESC[ #27 emit [char] [ emit ; + +\ position curser on terminal +: at-xy ( u1 u2 -- ) + 1+ swap 1+ swap ESC[ .n .;n [char] H emit +; + +\ clear page +: page ( -- ) + ESC[ ." 2J" 0 0 at-xy +; + +\ more definitions based on gforth' ansi.fs + +: foreground ( n -- | set foreground color to n ) + ESC[ #30 + .n [char] m emit +; + +: background ( n -- | set background color to n ) + ESC[ #40 + .n [char] m emit +; + +: text_normal ( -- | set normal text display ) + ESC[ [char] 0 emit [char] m emit +; + +: text_bold ( -- | set bold text ) + ESC[ [char] 1 emit [char] m emit +; + +: text_underline ( -- | set underlined text ) + ESC[ [char] 4 emit [char] m emit +; + +: text_blink ( -- | set blinking text ) + ESC[ [char] 5 emit [char] m emit +; + +: text_reverse ( -- | set reverse video text ) + ESC[ [char] 7 emit [char] m emit +; + + +#0 constant Black +#1 constant Red +#2 constant Green +#3 constant Yellow +#4 constant Blue +#5 constant Brown +#6 constant Cyan +#7 constant White diff --git a/amforth-6.5/common/lib/hardware/xonxoff.frt b/amforth-6.5/common/lib/hardware/xonxoff.frt new file mode 100644 index 0000000..d6a59d9 --- /dev/null +++ b/amforth-6.5/common/lib/hardware/xonxoff.frt @@ -0,0 +1,27 @@ +\ +\ enrich the serial IO with XON/XOFF +\ this is not a complete and fool-proof +\ + +\ #requires is.frt + +$11 constant XON +$13 constant XOFF + +\ original refill +variable xt-refill + +: refill-xon + XON emit + xt-refill @ execute + XOFF emit +; + +: +xonxoff + ['] refill defer@ xt-refill ! + ['] refill-xon is refill +; + +: -xonxoff + xt-refill @ is refill +; -- cgit v1.2.3