aboutsummaryrefslogtreecommitdiff
path: root/forth
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2018-09-12 02:07:41 +0200
committerDimitri Sokolyuk <demon@dim13.org>2018-09-12 02:07:41 +0200
commit6e1b8105f5da1411470dbaac3f18bf2d244106c6 (patch)
treec189c7850dfe626819d67ec24765212f86e8e4d1 /forth
parent91299174c2003a2f284bc84767dfe738774b055a (diff)
cleanup wiring
Diffstat (limited to 'forth')
-rw-r--r--forth/flash-led.fs10
-rw-r--r--forth/main.fs31
-rw-r--r--forth/see.fs77
3 files changed, 118 insertions, 0 deletions
diff --git a/forth/flash-led.fs b/forth/flash-led.fs
index e9b8657..08fc643 100644
--- a/forth/flash-led.fs
+++ b/forth/flash-led.fs
@@ -2,8 +2,18 @@
marker -flash-led-avr
\ PB5 is Arduino digital pin 13.
+$0023 constant pinb
$0024 constant ddrb
$0025 constant portb
+
+$0026 constant pinc
+$0027 constant ddrc
+$0028 constant portc
+
+$0029 constant pind
+$002a constant ddrd
+$002b constant portd
+
1 #5 lshift constant bit5
: init bit5 ddrb mset ; \ set pin as output
diff --git a/forth/main.fs b/forth/main.fs
new file mode 100644
index 0000000..7551f7c
--- /dev/null
+++ b/forth/main.fs
@@ -0,0 +1,31 @@
+-io
+marker -io \ define ports
+
+$23 constant pinb
+$24 constant ddrb
+$25 constant portb
+
+$26 constant pinc
+$27 constant ddrc
+$28 constant portc
+
+$29 constant pind
+$2a constant ddrd
+$2b constant portd
+
+: bv ( bit -- mask ) 1 swap lshift ;
+
+#5 bv portb 2constant led
+#5 bv ddrb mset
+
+#2 bv pind 2constant sr
+#2 bv ddrd mclr
+
+#4 bv pind 2constant sc
+#4 bv ddrd mclr
+
+#3 bv pind 2constant sl
+#3 bv ddrd mclr
+
+: read ( mask port -- flag )
+ c@ invert 0= swap drop ;
diff --git a/forth/see.fs b/forth/see.fs
new file mode 100644
index 0000000..a1c2deb
--- /dev/null
+++ b/forth/see.fs
@@ -0,0 +1,77 @@
+\ *********************************************************************
+\ Filename: see.txt *
+\ Date: 20.03.2017 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+-see
+marker -see
+hex ram
+: *@ dup @ ;
+: u.4 4 u.r ;
+: *@+ dup cell+ @ u.4 ;
+: 5sp 5 spaces ;
+: @braddr ( addr -- addr xt-addr )
+ *@ fff and dup 800 and
+ if f800 or then 2* over + cell+ ;
+: @xtaddr ( addr -- addr xt-addr )
+ dup cell+ @ xa> ;
+: .rjmp ( addr -- addr+2 ) @braddr u.4 cell+ ;
+: .br ( addr -- addr+2 )
+ *@ 3 rshift 7f and dup 40 and
+ if ff80 or then 2* over + cell+ u.4 cell+ ;
+: .reg ( addr -- addr )
+ dup @ 4 rshift 1f and ." r" decimal 2 u.r hex cell+ ;
+: .ldi ( addr -- addr )
+ *@ dup 4 rshift dup 000f and 0010 +
+ ." r" decimal 2 u.r hex
+ 00f0 and swap 000f and + 2 u.r cell+ ;
+: ?call ( addr -- addr f ) *@ fe0e and 940e - ;
+: ?ret ( addr -- addr f ) *@ 9508 - ;
+: ?rcall ( addr -- addr f ) *@ f000 and d000 - ;
+: ?jmp ( addr -- addr f ) *@ fe0e and 940c - ;
+: ?rjmp ( addr -- addr f ) *@ f000 and c000 - ;
+: ?breq ( addr -- addr f ) *@ fc07 and f001 - ;
+: ?brne ( addr -- addr f ) *@ fc07 and f401 - ;
+: ?brcc ( addr -- addr f ) *@ fc07 and f400 - ;
+: ?pop ( addr -- addr f ) *@ fe0f and 900f - ;
+: ?push ( addr -- addr f ) *@ fe0f and 920f - ;
+: ?st-y ( addr -- addr f ) *@ fe0f and 920a - ;
+: ?ldy+ ( addr -- addr f ) *@ fe0f and 9009 - ;
+: ?ijmp ( addr -- addr f ) *@ 9409 - ;
+: ?ldi ( addr -- addr f ) *@ f000 and e000 - ;
+: (see) ( addr -- addr' | false )
+ dup u.4
+ *@ u.4
+ ?call 0= if *@+ ." call " @xtaddr c>n .id cell+ cell+ else
+ ?rcall 0= if 5sp ." rcall " @braddr c>n .id cell+ else
+ ?breq 0= if 5sp ." breq " .br else
+ ?brne 0= if 5sp ." brne " .br else
+ ?brcc 0= if 5sp ." brcc " .br else
+ ?rjmp 0= if 5sp ." rjmp " .rjmp else
+ ?ijmp 0= if 5sp ." ijmp" drop false else
+ ?ret 0= if 5sp ." ret" drop false else
+ ?jmp 0= if *@+ ." jmp " @xtaddr c>n .id drop false else
+ ?pop 0= if 5sp ." pop " .reg else
+ ?push 0= if 5sp ." push " .reg else
+ ?ldy+ 0= if 5sp ." ld " .reg ." y+" else
+ ?st-y 0= if 5sp ." st -y " .reg else
+ ?ldi 0= if 5sp ." ldi " .ldi else
+ cell+
+ then then then then then
+ then then then then then
+ then then then then
+ cr ;
+
+: dis ( addr -- )
+ hex cr
+ begin (see) dup 0=
+ until drop ;
+
+: see ( "word" -- ) ' dis ;
+hex ram
+