aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/hardware
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
commit67d25d837ac55f28a366c0a3b262e439a6e75fc3 (patch)
treedf7715c7724c5935ab87c807f3b8b4ef529315e3 /amforth-6.5/common/lib/hardware
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/common/lib/hardware')
-rw-r--r--amforth-6.5/common/lib/hardware/1wire-crc8-test.frt54
-rw-r--r--amforth-6.5/common/lib/hardware/1wire-crc8.frt65
-rw-r--r--amforth-6.5/common/lib/hardware/1wire-ds18s20.frt32
-rw-r--r--amforth-6.5/common/lib/hardware/1wire.frt222
-rw-r--r--amforth-6.5/common/lib/hardware/date-time.frt29
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-compass.frt49
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-detect.frt40
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-eeprom-block.frt77
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-eeprom-value.frt19
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-eeprom.frt47
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-lcd.frt31
-rw-r--r--amforth-6.5/common/lib/hardware/i2c-value.frt23
-rw-r--r--amforth-6.5/common/lib/hardware/i2c.frt87
-rw-r--r--amforth-6.5/common/lib/hardware/int-critical-test.frt14
-rw-r--r--amforth-6.5/common/lib/hardware/int-critical.frt12
-rw-r--r--amforth-6.5/common/lib/hardware/mmc-test.frt96
-rw-r--r--amforth-6.5/common/lib/hardware/power-save.frt36
-rw-r--r--amforth-6.5/common/lib/hardware/spi-mmc.frt98
-rw-r--r--amforth-6.5/common/lib/hardware/timer-test.frt22
-rw-r--r--amforth-6.5/common/lib/hardware/timer.frt56
-rw-r--r--amforth-6.5/common/lib/hardware/vt100.frt59
-rw-r--r--amforth-6.5/common/lib/hardware/xonxoff.frt27
22 files changed, 1195 insertions, 0 deletions
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 <http://www.gnu.org/licenses/>.
+\
+\ 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
+;