aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/lib/bitnames.frt
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
commit67d25d837ac55f28a366c0a3b262e439a6e75fc3 (patch)
treedf7715c7724c5935ab87c807f3b8b4ef529315e3 /amforth-6.5/avr8/lib/bitnames.frt
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/avr8/lib/bitnames.frt')
-rw-r--r--amforth-6.5/avr8/lib/bitnames.frt155
1 files changed, 155 insertions, 0 deletions
diff --git a/amforth-6.5/avr8/lib/bitnames.frt b/amforth-6.5/avr8/lib/bitnames.frt
new file mode 100644
index 0000000..fdda840
--- /dev/null
+++ b/amforth-6.5/avr8/lib/bitnames.frt
@@ -0,0 +1,155 @@
+\ Code: Matthias Trute
+\ Text: M.Kalus
+
+\ A named port pin puts a bitmask on stack, wherin the set bit indicates which
+\ bit of the port register corresponds to the pin.
+\ And then puts the address of its port on stack too.
+
+\ Use it this way:
+\ PORTD 7 portpin: PD.7 ( define portD pin #7)
+\ PD.7 high ( turn portD pin #7 on, i.e. set it high-level)
+\ PD.7 low ( turn portD pin #7 off, i.e. set it low-level)
+\ PD.7 <ms> pulse ( turn portD pin #7 for <ms> high and low)
+\ the following words are for "real" IO pins only
+\ PD.7 pin_output ( set DDRD so that portD pin #7 is output)
+\ PD.7 pin_input ( set DDRD so that portD pin #7 is input)
+\ PD.7 pin_high? ( true if pinD pin #7 is high)
+\ PD.7 pin_low? ( true if pinD pin #7 is low)
+\
+\ multi bit operation
+\ PORTD F bitmask: PD.F ( define the lower nibble of port d )
+\ PD.F pin@ ( get the lower nibble bits )
+\ 5 PD.F pin! ( put the lower nibble bits, do not change the others )
+
+\ #require builds.frt
+
+: bitmask: ( C: "ccc" portadr bmask -- ) ( R: -- pinmask portadr )
+ <builds
+ , ,
+ does>
+ dup @i swap i-cell+ @i
+;
+
+: portpin: ( C: "ccc" portadr n -- ) ( R: -- pinmask portadr )
+ 1 over 7 and lshift >r \ bit position
+ 3 rshift + \ byte address
+ r> bitmask: \ portaddr may have changed
+;
+
+
+
+\ Turn a port pin on, dont change the others.
+: high ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ or ( -- portadr new-value)
+ swap ( -- new-value portadr)
+ c!
+;
+
+\ Turn a port pin off, dont change the others.
+: low ( pinmask portadr -- )
+ dup ( -- pinmask portadr portadr )
+ c@ ( -- pinmask portadr value )
+ rot ( -- portadr value pinmask )
+ invert and ( -- portadr new-value)
+ swap ( -- new-value port)
+ c!
+;
+
+
+\ synonym off low
+\ synonym on high
+
+\ pulse the pin
+: pulse ( pinmask portaddr time -- )
+ >r
+ 2dup high
+ r> 0 ?do 1ms loop
+ low
+;
+
+: is_low? ( pinmask portaddr -- f)
+ c@ and 0=
+;
+
+: is_high? ( pinmask portaddr -- f)
+ c@ over and =
+;
+
+: wait_low ( pinmask portaddr -- )
+ begin
+ 2dup is_low?
+ until 2drop
+;
+
+: wait_high_all ( pinmask portaddr -- )
+ begin
+ 2dup is_high?
+ until 2drop
+;
+
+\ write the pins masked as output
+\ read the current value, mask all but
+\ the desired bits and set the new
+\ bits. write back the resulting byte
+: pin! ( c pinmask portaddr -- )
+ dup ( -- c pm pa pa )
+ >r
+ c@ ( -- c pm c' )
+ over invert and ( -- c pm c'' )
+ >r ( -- c pm )
+ and
+ r> ( -- c c'' )
+ or r>
+ c!
+;
+
+
+\ Only for PORTx bits,
+\ because address of DDRx is one less than address of PORTx.
+
+\ Set DDRx so its corresponding pin is output.
+: pin_output ( pinmask portadr -- )
+ 1- high
+;
+
+\ Set DDRx so its corresponding pin is input.
+: pin_input ( pinmask portadr -- )
+ 1- low
+;
+
+\ PINx is two less of PORTx
+: pin_high? ( pinmask portaddr -- f)
+ 1- 1- c@ and
+;
+
+: pin_low? ( pinmask portaddr -- f)
+ 1- 1- c@ invert and
+;
+
+\ read the pins masked as input
+: pin@ ( pinmask portaddr -- c )
+ 1- 1- c@ and
+;
+
+\ toggle the pin
+: toggle ( pinmask portaddr -- )
+ 2dup pin_high? if
+ low
+ else
+ high
+ then
+;
+
+\ disable the pull up resistor
+: pin_pullup_off ( pinmask portaddr -- )
+ 2dup pin_input low
+;
+
+
+\ enable the pull up resistor
+: pin_pullup_on ( pinmask portaddr -- )
+ 2dup pin_input high
+;