aboutsummaryrefslogtreecommitdiff
path: root/forth
diff options
context:
space:
mode:
Diffstat (limited to 'forth')
-rw-r--r--forth/core.fs431
-rw-r--r--forth/depth.fs4
-rw-r--r--forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf (renamed from forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf)bin5418032 -> 5418032 bytes
-rw-r--r--forth/docs/ff5-elements.pdf (renamed from forth/ff5-elements.pdf)bin223242 -> 223242 bytes
-rw-r--r--forth/docs/ff5-sheet.pdf (renamed from forth/ff5-sheet.pdf)bin171382 -> 171382 bytes
-rw-r--r--forth/docs/ff5-tutorial-guide.pdf (renamed from forth/ff5-tutorial-guide.pdf)bin13376704 -> 13376704 bytes
-rw-r--r--forth/elegoo.fs23
-rwxr-xr-xforth/ff-shell.tcl341
-rw-r--r--forth/fib.fs5
-rw-r--r--forth/firmware/config.inc117
-rw-r--r--forth/firmware/ff-atmega.asm6092
-rw-r--r--forth/firmware/ff_uno.hex (renamed from forth/ff_uno.hex)0
-rw-r--r--forth/forth/2literal.fs14
-rw-r--r--forth/forth/avr/asm-examples.fs36
-rw-r--r--forth/forth/avr/asm.fs281
-rw-r--r--forth/forth/avr/asm2.fs192
-rw-r--r--forth/forth/avr/asm2test.fs32
-rw-r--r--forth/forth/avr/asmtest.fs59
-rw-r--r--forth/forth/avr/bit-test.fs58
-rw-r--r--forth/forth/avr/bit.fs77
-rw-r--r--forth/forth/avr/doloop.fs92
-rw-r--r--forth/forth/avr/i2c-base-avr.fs99
-rw-r--r--forth/forth/avr/i2c-ds1307.fs72
-rw-r--r--forth/forth/avr/irqAtmega128.fs45
-rw-r--r--forth/forth/avr/irqAtmega2560.fs45
-rw-r--r--forth/forth/avr/irqAtmega328.fs42
-rw-r--r--forth/forth/avr/pick.fs6
-rw-r--r--forth/forth/avr/see.fs (renamed from forth/see.fs)0
-rw-r--r--forth/forth/avr/task-test-arduino-mega2560.fs48
-rw-r--r--forth/forth/avr/task-test-arduino-uno.fs45
-rw-r--r--forth/forth/avr/task-test.fs45
-rw-r--r--forth/forth/avr/task.fs160
-rw-r--r--forth/forth/avr/task2-test.fs47
-rw-r--r--forth/forth/avr/us.fs37
-rw-r--r--forth/forth/avr/xdump.fs45
-rw-r--r--forth/forth/case-test.fs23
-rw-r--r--forth/forth/case.fs52
-rw-r--r--forth/forth/core.fs49
-rw-r--r--forth/forth/ct-test.fs22
-rw-r--r--forth/forth/ct.fs40
-rw-r--r--forth/forth/doloop-test.fs32
-rw-r--r--forth/forth/dump.fs26
-rw-r--r--forth/forth/forget.fs18
-rw-r--r--forth/forth/free.fs25
-rw-r--r--forth/forth/help.fs68
-rw-r--r--forth/forth/helpwords.fs255
-rw-r--r--forth/forth/i2c-detect.fs54
-rw-r--r--forth/forth/jmptbl-test.fs70
-rw-r--r--forth/forth/jmptbl.fs76
-rw-r--r--forth/forth/jt-test.fs9
-rw-r--r--forth/forth/jt.fs42
-rw-r--r--forth/forth/math.fs79
-rw-r--r--forth/forth/sieve.fs43
-rw-r--r--forth/forth/sieve2.fs59
-rw-r--r--forth/forth/tc74-app.fs40
-rw-r--r--forth/forth/vt100-test.fs36
-rw-r--r--forth/forth/vt100.fs55
-rw-r--r--forth/main.fs36
-rw-r--r--forth/rand.fs17
-rw-r--r--forth/uno.fs138
60 files changed, 9920 insertions, 34 deletions
diff --git a/forth/core.fs b/forth/core.fs
new file mode 100644
index 0000000..1682aa6
--- /dev/null
+++ b/forth/core.fs
@@ -0,0 +1,431 @@
+\ Some extra core words
+
+-core
+marker -core
+hex ram
+
+\ Interpret a string. The string must be in ram
+: evaluate ( caddr n -- )
+ 'source 2@ >r >r >in @ >r
+ interpret
+ r> >in ! r> r> 'source 2!
+;
+
+: forget ( --- name )
+ bl word latest @ (f) ?abort?
+ c>n 2- dup @ ?abort?
+ dup flash dp ! @ latest ! ram
+;
+
+ ( addr n c -- ) \ fill addr to addr+n with c
+: fill rot !p>r swap for dup pc! p+ next r>p drop ;
+
+\ addr n --
+: erase 0 fill ;
+
+\ addr n --
+: blanks bl fill ;
+
+\ x -- 0 | x x
+: ?dup dup if inline dup then ;
+
+\ nfa -- flag
+: in? c@ $40 and ;
+
+\ addr -- addr+1 n
+: count c@+ ;
+
+\ MCU with eeprom
+: .free
+ cr ." Flash:" flash hi here - u. ." bytes"
+ cr ." Eeprom:" eeprom hi here - u. ." bytes"
+ cr ." Ram:" ram hi here - u. ." bytes"
+;
+
+\ xu ... x0 u -- xu ... x0 xu
+: pick 2* sp@ + @ ;
+
+-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
+
+-doloop
+marker -doloop
+
+: compileonly $10 shb ;
+
+#20 constant ind inlined \ R18:R19 are unused by the kernel
+
+: (do) ( limit index -- R: leave oldindex xfaxtor )
+ r>
+ dup >a xa> @ >r \ R: leave
+ ind @ >r \ R: leave oldindex
+ swap $8000 swap - dup >r \ R: leave oldindex xfactor
+ + ind !
+ a> 1+ >r
+; compileonly
+
+: (?do) ( limit index -- R: leave oldindex xfactor )
+ 2dup xor
+ if
+ [ ' (do) ] again \ branch to (do)
+ then
+ r> xa> @ >r 2drop
+; compileonly
+
+: (+loop) ( n -- )
+ [ $0f48 i, ] \ add r20, tosl
+ [ $1f59 i, ] \ add r21, tosh
+ inline drop
+; compileonly
+
+: unloop
+ r>
+ rdrop r> ind ! rdrop
+ >r
+; compileonly
+
+: do
+ postpone (do)
+ postpone begin
+ flash 2 allot ram \ leave address
+ postpone begin
+; immediate compileonly
+
+: ?do
+ postpone (?do)
+ postpone begin
+ flash 2 allot ram \ leave address
+ postpone begin
+; immediate compileonly
+
+: leave
+ rdrop rdrop r> ind !
+; compileonly
+
+: i
+ ind @ rp@ 3 + @ >< -
+; compileonly
+
+: j
+ rp@ 5 + @ >< rp@ 9 + @ >< -
+; compileonly
+
+
+: loop
+ $0d46 i, $1d55 i, \ add 1 to r20:r21
+\ postpone (loop)
+ $f00b i, \ bra +2 if overflow
+ postpone again
+ postpone unloop
+ flash here >xa swap ! ram
+; immediate compileonly
+
+: +loop
+ postpone (+loop)
+ $f00b i, \ bra +2 if overflow
+ postpone again
+ postpone unloop
+ flash here >xa swap ! ram
+; immediate compileonly
+
+-bit
+marker -bit
+: (bio) ( c-addr -- in/out-addr ) $20 - dup $5 lshift or $60f and ;
+: (bit) ( c-addr bit flag "name" -- )
+ : >r
+ over $40 < if
+ swap $20 - 3 lshift or
+ r>
+ if $9a00 \ sbi io-addr, bit
+ else $9800 \ cbi io-addr, bit
+ then or i,
+ else
+ over $60 <
+ if over (bio) $b100 or \ in r16 io-addr
+ else $9100 i, over \ lds r16 c-addr
+ then i,
+ 1 swap lshift
+ r>
+ if $6000 >r
+ else $7000 >r invert $ff and
+ then dup 4 lshift or $f0f and r> or i, \ andi/ori r16, mask
+ dup $60 <
+ if (bio) $b900 or \ out io-addr r16
+ else $9300 i, \ sts c-addr r16
+ then i,
+ then
+ $9508 i, \ return
+ postpone [
+;
+
+\ Define a word that clears a bit in ram
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit0: false (bit) ;
+
+\ Define a word that sets a bit in ram
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit1: true (bit) ;
+
+\ Define a word that leaves a true flag if a bit in ram is one
+\ and a false flag if a bit is zero.
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit?:
+ :
+ $939a i, $938a i, $ef8f i, $ef9f i, \ true
+ over $40 < if
+ swap $20 - 3 lshift or $9b00 or i, \ sbis io-addr, bit
+ else
+ over $60 <
+ if swap (bio) $b100 or \ in r16 io-addr
+ else $9100 i, swap \ lds r16 c-addr
+ then i, $ff00 or i, \ sbrs r16, bit
+ then
+ $9601 i, \ 1+
+ $9508 i, \ return
+ postpone [
+;
+
+-task
+marker -task
+hex ram
+
+\ Near definition saves memory !
+: up! up ! ;
+: up@ up @ ;
+: op@ operator @ ;
+: ul@ ulink @ ;
+: ul! ulink ! ;
+: op! op@ up! ;
+\ access user variables of other task
+: his ( task-addr var-addr -- addr )
+ up@ - swap @ +
+;
+
+\ Define a new task
+\ A new task must be defined in the flash memory space
+: task: ( tibsize stacksize rsize addsize -- )
+ flash create
+ up@ s0 - dup \ Basic size ts ss rs as bs bs
+ ram here + flash , \ User pointer ts ss rs as bs
+ 4 for
+ over , +
+ next
+ cell+ \ Task size
+ ram allot
+;
+
+\ Initialise a user area and link it to the task loop
+\ May only be executed from the operator task
+: tinit ( taskloop-addr task-addr -- )
+ \ use task user area
+ @+ up! \ a addsize-addr
+ ul@ if \ ? Already running
+ 2drop
+ else
+ \ Pointer to task area
+ dup 2- task !
+ \ r0 = uarea+addsize+rsize
+ @+ swap @+ rot + up@ + \ a ssize-addr r0
+ \ Save r0
+ r0 ! \ a ssize-addr
+ \ s0 = r0 + ssize
+ @ r0 @ + s0 ! \ a
+ \ Store task-loop address to the return stack
+ r0 @ x>r \ rsp
+ \ Store SP to return stack
+ 1- dup s0 @ swap ! \ rsp
+ \ Store current rsp and space for saving TOS and P PAUSE
+ 5 - rsave ! \
+ \ tiu = s0 + 2
+ s0 @ 2+ tiu !
+ 0 ul!
+ 0 task 2+ ! \ clear status and cr flag
+ decimal \ Set the base to decimal
+ then
+ op! \ run the operator task again
+;
+
+\ Insert a new task after operator in the linked list.
+\ May only be executed from the operator task
+: run ( task-addr -- )
+ @ up! ul@ 0= if \ ? Already running
+ up@ \ task-uarea
+ op! ul@ \ task-uarea operator-ulink
+ over ul!
+ swap up! ul!
+ then
+ op! \ run operator task
+;
+
+\ End a task by linking it out from the linked list
+\ May only be executed from the operator task
+: end ( task-addr -- )
+ @ up! ul@ if
+ up@
+ op!
+ begin \ find the uarea in the linked list
+ dup ul@ <> \ uarea flag
+ while
+ ul@ up! \ uarea
+ repeat
+ up@ \ uarea prev-uarea
+ swap up! \ prev-uarea
+ ul@ \ prev-uarea next-uarea
+ 0 ul! \ ulink of a ended task is zero
+ swap up! \ next-uarea
+ ul! \
+ then
+ op!
+;
+
+\ End all tasks except the operator task
+\ May only be executed from the operator task
+: single ( -- )
+ ul@ op@ <> if \ Are there any running tasks
+ ul@ op@ ul! \ link operator to himself
+ up! \ move to next user area
+ begin
+ ul@ op@ <> \ is this the last linked user area
+ while
+ ul@ 0 ul! \ write zero to ulink
+ up! \ and move to next user area
+ repeat
+ 0 ul!
+ op!
+ then
+;
+
+\ List all running tasks
+: tasks ( -- )
+ up@ op!
+ begin
+ up@
+ task @ 6 - op! c>n .id space
+ up!
+ ul@ op@ -
+ while
+ ul@ up!
+ repeat
+ up!
+;
+
+-io
+marker -io
+
+\ TIMER_COUNTER_1
+$6f constant TIMSK1 \ Timer/Counter Interrupt Mask Register
+$36 constant TIFR1 \ Timer/Counter Interrupt Flag register
+$80 constant TCCR1A \ Timer/Counter1 Control Register A
+$81 constant TCCR1B \ Timer/Counter1 Control Register B
+$82 constant TCCR1C \ Timer/Counter1 Control Register C
+$84 constant TCNT1 \ Timer/Counter1 Bytes
+$88 constant OCR1A \ Timer/Counter1 Output Compare Register Bytes
+$8a constant OCR1B \ Timer/Counter1 Output Compare Register Bytes
+$86 constant ICR1 \ Timer/Counter1 Input Capture Register Bytes
+$43 constant GTCCR \ General Timer/Counter Control Register
+
+\ TIMER_COUNTER_2
+$70 constant TIMSK2 \ Timer/Counter Interrupt Mask register
+$37 constant TIFR2 \ Timer/Counter Interrupt Flag Register
+$b0 constant TCCR2A \ Timer/Counter2 Control Register A
+$b1 constant TCCR2B \ Timer/Counter2 Control Register B
+$b2 constant TCNT2 \ Timer/Counter2
+$b4 constant OCR2B \ Timer/Counter2 Output Compare Register B
+$b3 constant OCR2A \ Timer/Counter2 Output Compare Register A
+$b6 constant ASSR \ Asynchronous Status Register
+
+\ AD_CONVERTER
+$7c constant ADMUX \ The ADC multiplexer Selection Register
+$78 constant ADC \ ADC Data Register Bytes
+$7a constant ADCSRA \ The ADC Control and Status register A
+$7b constant ADCSRB \ The ADC Control and Status register B
+$7e constant DIDR0 \ Digital Input Disable Register
+
+\ ANALOG_COMPARATOR
+$50 constant ACSR \ Analog Comparator Control And Status Register
+$7f constant DIDR1 \ Digital Input Disable Register 0x1
+
+\ PORTB
+$25 constant PORTB \ Port B Data Register
+$24 constant DDRB \ Port B Data Direction Register
+$23 constant PINB \ Port B Input Pins
+
+\ PORTC
+$28 constant PORTC \ Port C Data Register
+$27 constant DDRC \ Port C Data Direction Register
+$26 constant PINC \ Port C Input Pins
+
+\ PORTD
+$2b constant PORTD \ Port D Data Register
+$2a constant DDRD \ Port D Data Direction Register
+$29 constant PIND \ Port D Input Pins
+
+-main
+marker -main
diff --git a/forth/depth.fs b/forth/depth.fs
new file mode 100644
index 0000000..b4bb661
--- /dev/null
+++ b/forth/depth.fs
@@ -0,0 +1,4 @@
+-depth
+marker -depth
+
+: depth s0 @ 2- sp@ - 2/ ;
diff --git a/forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf b/forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf
index e98e8dc..e98e8dc 100644
--- a/forth/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf
+++ b/forth/docs/Atmel-42735-8-bit-AVR-Microcontroller-ATmega328-328P_Datasheet.pdf
Binary files differ
diff --git a/forth/ff5-elements.pdf b/forth/docs/ff5-elements.pdf
index d7ea390..d7ea390 100644
--- a/forth/ff5-elements.pdf
+++ b/forth/docs/ff5-elements.pdf
Binary files differ
diff --git a/forth/ff5-sheet.pdf b/forth/docs/ff5-sheet.pdf
index 918fa33..918fa33 100644
--- a/forth/ff5-sheet.pdf
+++ b/forth/docs/ff5-sheet.pdf
Binary files differ
diff --git a/forth/ff5-tutorial-guide.pdf b/forth/docs/ff5-tutorial-guide.pdf
index 2fb656d..2fb656d 100644
--- a/forth/ff5-tutorial-guide.pdf
+++ b/forth/docs/ff5-tutorial-guide.pdf
Binary files differ
diff --git a/forth/elegoo.fs b/forth/elegoo.fs
new file mode 100644
index 0000000..f6d5391
--- /dev/null
+++ b/forth/elegoo.fs
@@ -0,0 +1,23 @@
+-pwm
+marker -pwm
+
+$2a constant ddrd
+$44 constant tccr0a
+$45 constant tccr0b
+$47 constant ocr0a
+$48 constant ocr0b
+
+: timer0init
+ #01100000 ddrd mset \ output PD6 PD5
+ #10100011 tccr0a c! \ mode3: non-inverted pwm A and B
+ #00000101 tccr0b c! \ prescale/1024
+;
+
+: setA ocr0a c! ;
+: setB ocr0b c! ;
+
+: go
+ timer0init
+ $1f setA
+ $3f setB
+;
diff --git a/forth/ff-shell.tcl b/forth/ff-shell.tcl
new file mode 100755
index 0000000..1aca0cb
--- /dev/null
+++ b/forth/ff-shell.tcl
@@ -0,0 +1,341 @@
+#!/usr/bin/env wish
+# ff-shell.tcl
+# The Manual
+# ----------
+# This simple shell is built around the Tcl/Tk text widget.
+# Using a custom binding, key presses sent to the widget
+# are redirected to the serial port and the FlashForth micro
+# attached to that port. Incoming characters from the micro
+# are received from the serial port and are inserted into the
+# widget at the end of the text. An update to the GUI is
+# triggered at the end of every line.
+#
+# A file is sent to the serial port, one line at a time.
+# To allow the GUI to update smoothly in this single-threaded
+# program, the lines to send are accumulated into a list and a
+# procedure to send the first line is scheduled.
+# For each line to be sent, the procedure checks if it is
+# still waiting for a carriage-return from the microcontroller.
+# If it is, the work of sending the line is rescheduled for
+# a later time. If it is not waiting, the line is sent
+# one character at a time. Incoming characters are inserted
+# at the end of the text widget as they arrive.
+#
+# Copy-and-Paste insertions to the text widget are intercepted
+# by the <<Paste>> binding and handled in a similar manner
+# as sending lines from a file.
+#
+# At any point in time, the text from the widget may be saved
+# to a file. This might be good a way to save a session or
+# collect large amounts of output from the microcontroller.
+#
+# You will need to run with sufficient privilege to access
+# the serial port.
+# On Ubuntu, this can be done by starting the program like so:
+# $ sudo ./ff-shell.tcl
+#
+# Author
+# ------
+# P.A.Jacobs
+# School of Engineering, Uni of Qld.
+#
+# Version
+# -------
+# 2015-04-03
+# Initial code cobbled together from a few examples, especially
+# Rolf Schroedter's simple terminal at http://wiki.tcl.tk/3642
+# and Mikael Nordman's ff-shell.py.
+# 2015-04-25, 26
+# Added status line and selection of speed, etc, from the GUI.
+#
+# Licence
+# -------
+# GPL, as per the rest of FlashForth.
+#
+# --------------------------------------------------------------
+# Configuration
+# Set defaults that suit your environment.
+
+set ::baudRate 9600; # 38400
+set ::parity "n"; # n=none e=even o=odd m=mark s=space
+set ::dataBits 8; # 7 8
+set ::stopBits 1; # 1 2
+set ::parityAndBits "$::parity,$::dataBits,$::stopBits"
+set ::handShake xonxoff; # none xonxoff rtscts
+if { [string equal $::tcl_platform(os) Linux] } {
+ set ::serialPortName "/dev/ttyACM0"
+} else {
+ set ::serialPortName "/dev/cuaU0"
+}; # end if
+set ::portState closed
+
+set ::textWidth 80
+set ::textHeight 24
+set ::textFont Courier
+
+set ::afterLineMilliseconds 20
+
+# --------------------------------------------------------------
+# Sending and receiving characters, one at a time.
+
+set ::waitingForCR false
+
+proc serialIn { channel } {
+ if { [chan eof $channel] } {
+ puts "Oops serial channel read: eof"
+ closeSerialPort
+ return
+ }
+ if { [catch {chan read $channel 1} character] } {
+ puts "Oops serial channel read: $character"
+ return
+ }
+ if { [string length $character] == 0 } {
+ return
+ }
+ switch -regexp -- $character {
+ \x07 { bell }
+ \x08 { deleteLastChar }
+ \x09 { addToLogText $character }
+ \x0a { }
+ \x0d { addToLogText "\n"; set ::waitingForCR false; showLogTail; update }
+ \x11 { puts -nonewline Xon }
+ \x13 { puts -nonewline Xoff }
+ [\x20-\x7e] { addToLogText $character }
+ }; # end switch
+}; # end serialIn
+
+proc serialOut { channel character } {
+ # puts -nonewline $channel $character; flush $channel
+ # send CR and BS through but not LF
+ switch -regexp -- $character {
+ \x0a {}
+ \x08 -
+ \x09 -
+ \x0d -
+ \x0f -
+ [\x20-\x7e] { puts -nonewline $channel $character; flush $channel }
+ }; # end switch
+}; # end serialOut
+
+proc openSerialPort {} {
+ if { [catch {open $::serialPortName r+} result] } {
+ puts "openSerialPort: $result"
+ set ::portState closed
+ } else {
+ set ::tty $result
+ puts "Serial channel is open as $::tty"
+ # We allow a short timeout period to prevent the read function
+ # from stalling for too long.
+ chan configure $::tty -mode $::baudRate,$::parityAndBits -timeout 10 \
+ -encoding binary -translation binary -handshake $::handShake \
+ -buffering none -buffersize 8192 -blocking false
+ chan event $::tty readable [list serialIn $::tty]
+ set ::portState open
+ }
+}; # end openSerialPort
+
+proc closeSerialPort {} {
+ if { [catch {close $::tty} err] } {
+ puts "Close serial port failed: $err"
+ }
+ set ::portState closed
+}; # end closeSerialPort
+
+# --------------------------------------------------------------
+# GUI elements
+wm title . "FlashForth Shell"
+# Main menu allow us a convenient way to exit.
+menu .mb
+. configure -menu .mb
+menu .mb.file -tearoff 0
+.mb.file add command -label "Send..." -command { sendFile }
+.mb.file add command -label "Exit" -command { displayExitDialog }
+.mb add cascade -label File -menu .mb.file
+menu .mb.log -tearoff 0
+.mb.log add command -label "Clear" -command { clearLogText }
+.mb.log add command -label "Save..." -command { saveLogText }
+.mb add cascade -label Log -menu .mb.log
+menu .mb.micro -tearoff 0
+.mb.micro add command -label "Warm restart" -command { warmRestart }
+.mb add cascade -label Micro -menu .mb.micro
+menu .mb.help -tearoff 0
+.mb.help add command -label "About..." -command { displayAboutMessage }
+.mb.help add command -label "Hints" -command { displayHints }
+.mb add cascade -label Help -menu .mb.help
+
+proc displayExitDialog {} {
+ if [tk_messageBox -type yesno -icon question -message "Really exit?"] {
+ closeSerialPort
+ exit
+ }
+}
+
+proc displayAboutMessage {} {
+ tk_messageBox -type ok -icon info -parent . \
+ -message "ff-shell in Tcl\nA simple shell for FlashForth.\n2015-05-01"
+}
+
+proc displayHints {} {
+ set message {
+ "\n----------------------------------------------------------"
+ "\nType directly into the text window. Characters will go to"
+ "\nthe microcontroller, one at a time. Incoming characters"
+ "\nfrom the microcontroller will appear in the text window."
+ "\n"
+ "\nSending a file: For every line of the file, characters go"
+ "\none at a time to the microcontroller, but the shell will"
+ "\nwait for a carriage-return from the microcontroller before"
+ "\nsending the next line."
+ "\n"
+ "\nPasting a selection of text works in a similar way to"
+ "\nsending a file. You should be able to paste large sections"
+ "\nof text without overruns."
+ "\n"
+ "\nKeyboard short-cuts:"
+ "\nControl-Shift-v send selection to micro"
+ "\nControl-Shift-s save log"
+ "\nControl-Shift-x exit"
+ "\nControl-Shift-o warm restart of micro"
+ "\n----------------------------------------------------------"
+ "\n"
+ }
+ foreach line $message { addToLogText $line }
+}
+
+# A scrolling text window to log messages
+set textFrame [ttk::frame .tf]
+set ::logText [text .tf.t -height $::textHeight -width $::textWidth \
+ -font $::textFont -wrap char \
+ -yscrollcommand [list $textFrame.vsb set] ]
+set textScrollBar [ttk::scrollbar .tf.vsb -orient vertical \
+ -command {$::logText yview} ]
+pack $::logText -side left -expand 1 -fill both
+pack $textScrollBar -side left -fill y
+pack $textFrame -fill both -expand 1
+
+# A status line
+set statusFrame [ttk::labelframe .sf -text "Serial Port"]
+set lab1 [ttk::label .sf.lab1 -text "Device:"]
+set deviceEntry [ttk::entry .sf.entr1 -width 15 -textvariable ::serialPortName]
+pack $lab1 $deviceEntry -side left
+set lab2 [ttk::label .sf.lab2 -text "Speed:"]
+set speedEntry [ttk::entry .sf.entr2 -width 8 -textvariable ::baudRate]
+pack $lab2 $speedEntry -side left
+set lab3 [ttk::label .sf.lab3 -text "ParityAndBits:"]
+set entr3 [ttk::entry .sf.entr3 -width 6 -textvariable ::parityAndBits -state readonly]
+pack $lab3 $entr3 -side left
+set lab4 [ttk::label .sf.lab4 -text "Hand Shake:"]
+set entr4 [ttk::entry .sf.entr4 -width 7 -textvariable ::handShake -state readonly]
+pack $lab4 $entr4 -side left
+set lab5 [ttk::label .sf.lab5 -text "State:"]
+set entr5 [ttk::entry .sf.entr5 -width 6 -textvariable ::portState -state readonly]
+pack $lab5 $entr5 -side left
+pack $statusFrame -fill x -expand 0
+
+bind $deviceEntry <Return> { closeSerialPort; openSerialPort }
+bind $speedEntry <Return> { closeSerialPort; openSerialPort }
+
+proc addToLogText { txt } {
+ $::logText insert end "$txt"
+}
+
+proc showLogTail {} {
+ $::logText yview moveto 1.0
+}
+
+proc deleteLastChar {} {
+ $::logText delete "end-2c"
+ $::logText yview moveto 1.0
+}
+
+proc clearLogText {} {
+ $::logText delete 1.0 end
+}
+
+set ::saveFileName {}
+
+proc saveLogText {} {
+ set ::saveFileName [tk_getSaveFile -initialfile $::saveFileName \
+ -title "Save log text to file"]
+ if {[string length $::saveFileName] > 0} {
+ set fp [open $::saveFileName "w"]
+ puts $fp [$::logText get 1.0 end]
+ close $fp
+ }
+}; # end saveLogText
+
+proc sendTextChar { character } {
+ # We use this function in the key-binding for the logText widget.
+ # The break is to stop the default binding from inserting another
+ # character into the widget.
+ serialOut $::tty $character
+ return -code break
+}
+
+set ::linesToSend {}
+
+proc sendFirstLine {} {
+ if {$::waitingForCR} {
+ # reschedule the current work
+ after $::afterLineMilliseconds sendFirstLine
+ return
+ }
+ # Pop the first line from the list and send it.
+ set line [lindex $::linesToSend 0]
+ set ::linesToSend [lreplace $::linesToSend 0 0]
+ foreach character [split $line {}] {
+ serialOut $::tty $character
+ after 1; # 1ms pause after each character
+ }
+ serialOut $::tty "\r"
+ set ::waitingForCR true
+ if {[llength $::linesToSend] > 0} {
+ # there is more work to do
+ after $::afterLineMilliseconds sendFirstLine
+ }
+}; # end sendLine
+
+set ::sendFileName {}
+
+proc sendFile {} {
+ set ::sendFileName [tk_getOpenFile -initialfile $::sendFileName \
+ -title "Open file to send"]
+ if {[string length $::sendFileName] > 0} {
+ set fp [open $::sendFileName "r"]
+ while {[gets $fp line] >= 0} { lappend ::linesToSend $line }
+ close $fp
+ sendFirstLine
+ }
+}; # end sendFile
+
+proc sendSelection { text } {
+ foreach line [split $text "\n"] { lappend ::linesToSend $line }
+ sendFirstLine
+ return -code break
+}; # end sendSelection
+
+# The following binding redirects key presses in the text widget
+# to the serial-port.
+bind $::logText <Any-Key> [list sendTextChar %A]
+
+# The following virtual event can be triggered with Control-Shift-v
+# or with clicking the middle mouse button in X-Windows.
+# The selected region of text is sent to the serial port.
+event add <<PasteSelection>> <Control-V>
+bind $::logText <<PasteSelection>> { sendSelection [selection get] }
+
+# Keyboard short-cuts.
+bind $::logText <Control-F> { sendFile }
+bind $::logText <Control-S> { saveLogText }
+bind $::logText <Control-X> { displayExitDialog }
+
+proc warmRestart {} {
+ serialOut $::tty "\x0f"; # Control-O
+}
+
+# --------------------------------------------------------------
+# Initialize streams and hand control over to the event loop.
+openSerialPort
+update idletasks
+focus $::logText
diff --git a/forth/fib.fs b/forth/fib.fs
new file mode 100644
index 0000000..8f4cfbc
--- /dev/null
+++ b/forth/fib.fs
@@ -0,0 +1,5 @@
+-fib
+marker fib
+
+: fib ( n -- fib )
+ 0 1 rot 0 ?do over + swap loop drop ;
diff --git a/forth/firmware/config.inc b/forth/firmware/config.inc
new file mode 100644
index 0000000..9c6cb9e
--- /dev/null
+++ b/forth/firmware/config.inc
@@ -0,0 +1,117 @@
+;;; FlashForth device configuration for Atmega devices
+
+; Select the include file for your micro controller
+;.include "m2561def.inc" ;
+;.include "m2560def.inc" ; Tested Fuses: E:0xff H:0xdc L:0xff
+;.include "m128def.inc" ; Tested Fuses: E:0xff H:0xdc L:0xff
+;.include "m168pdef.inc"
+;.include "m328pdef.inc" ; Tested Fuses: E:0xff H:0xda L:0xff
+.include "m328def.inc" ; Tested Fuses: E:0xff H:0xda L:0xff
+;.include "m32adef.inc"
+;.include "m644pdef.inc"
+
+; Oscillator frequency in herz
+.equ FREQ_OSC = 16000000
+
+; Define the UART used for the operator
+.equ OPERATOR_UART = 0 ; 0 or 1
+
+;;; UART0 configuration
+;;; Note: With Arduino Uno R3 and MEGA R3 the USB to serial bridge latency and queues
+;;; disturb the XON/XOFF flow control.
+;;; The workaround is to use XON/XOFF flow control and 1 ms intercharacter delay in the terminal program. Or use the ff-shell.py which adds CR LF flow control.
+.equ BAUDRATE0 = 38400 ; Serial baudrate UART0
+.equ U0FC_TYPE = 1 ; 1 = XON/XOFF, 2=CTS/RTS
+.equ U0RTS_PORT = portd
+.equ U0RTS_DDR = ddrd
+.equ U0RTS_BIT = 3
+
+;;; UART1 configuration
+.equ BAUDRATE1= 38400 ; Serial baudrate UART1
+.equ U1FC_TYPE = 1 ; 1 = XON/XOFF, 2=CTS/RTS
+.equ U1RTS_PORT = portd
+.equ U1RTS_DDR = ddrd
+.equ U1RTS_BIT = 4
+
+; Default number base
+.equ BASE_DEFAULT = 10 ; 16 = hexadecimal, 10 = decimal
+
+; Set to 1 for power save when CPU is idle
+.equ IDLE_MODE = 1
+
+; Enable the cpu load measurement. Uses Timer 1. Needs IDLE_MODE = 1
+.equ CPU_LOAD = 0
+
+; CPU load indicator led definitions. Needs IDLE_MODE = 1
+.equ CPU_LOAD_LED = 1 ; set to 1 to enable
+.equ CPU_LOAD_DDR = ddrb
+.equ CPU_LOAD_PORT = portb ; avr-p28:portc arduinomega:portb arduinouno:portb
+.equ CPU_LOAD_BIT = 5 ; avr-p28:pin5 arduinomega:pin7 ardinouno:pin5
+.equ CPU_LOAD_LED_POLARITY = 1 ; avr-p28: 0 = low on port turns on led,
+ ; arduino : 1 = high on port turns on led
+
+; Define the startup delay for the turnkey words. Milliseconds
+.equ TURNKEY_DELAY = 2000 ; milliseconds
+
+; UART buffer sizes
+.equ RX0_BUF_SIZE = 32 ; 8,16,32,64
+.equ RX0_OFF_FILL = 4 ; Fill level for XOFF
+
+.equ RX1_BUF_SIZE = 32 ; 8,16,32,64
+.equ RX1_OFF_FILL = 4 ; Fill level for XOFF
+
+;;; USER AREA sizes for the OPERATOR task
+.equ RETURN_STACK_SIZE = 64 ; 48 cells return stack
+.equ PARAMETER_STACK_SIZE = 96 ; 32 cells parameter stack
+.equ TIB_SIZE = 90 ; 80 chars tib size + 10 chars hold area
+
+; Set to 1 to allow control-o to reset FlashForth from the operator UART
+.equ CTRL_O_WARM_RESET = 1
+
+; Select which timer to use for the system millisecond ticks 0, 1, 2
+.equ MS_TIMER = 0
+
+; Debug flash and eeprom writes
+; Prints F=Write to FLASH E=Write to EEPROM
+.equ DEBUG_FLASH = 0
+
+#if defined(__ATmega2560__)
+#define partstring "ATmega2560"
+#elif defined(__ATmega328P__)
+#define partstring "ATmega328P"
+#elif defined(__ATmega328__)
+#define partstring "ATmega328"
+#elif defined(__ATmega128__)
+#define partstring "ATmega128"
+#elif defined(__ATmega2561__)
+#define partstring "ATmega2561"
+#elif defined(__ATmega644__)
+#define partstring "ATmega644"
+#else
+#define partstring "ATmega"
+#endif
+
+.if MS_TIMER == 0
+.ifdef OC0Aaddr
+.equ MS_TIMER_ADDR = OC0Aaddr
+.else
+.equ MS_TIMER_ADDR = OC0addr
+.endif
+.endif
+
+.if MS_TIMER == 1
+.ifdef OC1Aaddr
+.equ MS_TIMER_ADDR = OC1Aaddr
+.else
+.equ MS_TIMER_ADDR = OC1addr
+.endif
+.endif
+
+.if MS_TIMER == 2
+.ifdef OC2Aaddr
+.equ MS_TIMER_ADDR = OC2Aaddr
+.else
+.equ MS_TIMER_ADDR = OC2addr
+.endif
+.endif
+
diff --git a/forth/firmware/ff-atmega.asm b/forth/firmware/ff-atmega.asm
new file mode 100644
index 0000000..555e5c2
--- /dev/null
+++ b/forth/firmware/ff-atmega.asm
@@ -0,0 +1,6092 @@
+;**********************************************************************
+; *
+; Filename: FlashForth.asm *
+; Date: 22.03.2017 *
+; File Version: 5.0 *
+; MCU: Atmega *
+; Copyright: Mikael Nordman *
+; Author: Mikael Nordman *
+; *
+;**********************************************************************
+; FlashForth is a standalone Forth system for microcontrollers that
+; can flash their own flash memory.
+;
+; Copyright (C) 2017 Mikael Nordman
+
+; This program is free software: you can redistribute it and/or modify
+; it under the terms of the GNU General Public License version 3 as
+; published by the Free Software Foundation.
+;
+; 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/>.
+;
+; Modified versions of FlashForth must be clearly marked as such,
+; in the name of this file, and in the identification
+; displayed when FlashForth starts.
+;**********************************************************************
+
+; Include the FlashForth configuration file
+.include "config.inc"
+
+; Define the FF version date string
+#define DATE "22.03.2017"
+
+
+; Register definitions
+ .def upl = r2 ; not in interrupt
+ .def uph = r3 ; not in interrupt
+ .def r_zero = r5 ; read only zero
+ .def r_one = r6 ; read only one
+ .def r_two = r7 ; read only two
+ .def t8 = r8 ; Not in interrupt
+ .def wflags = r9 ; not in interrupt
+
+ .def loadreg0 = r4 ;
+ .def loadreg1 = r12
+ .def loadreg2 = r13
+
+
+ .def ibasel=r10 ; Not in interrupt
+ .def ibaseh=r11 ; Not in interrupt
+ .def ms_count = r14 ; Not in interrupt
+ .def ms_count1 = r15 ; Not in interrupt
+ .def t0 = r16
+ .def t1 = r17
+ .def t2 = r0 ; Not in interrupt
+ .def t3 = r1 ; Not in interrupt
+
+ .def al = r18
+ .def ah = r19
+ .def pl = r20 ; P Register and FOR..LOOP INDEX variable
+ .def ph = r21
+
+ .def FLAGS1 = r22 ; Not in interrupt
+ .def FLAGS2 = r23 ; Not in interrupt
+ .def tosl = r24
+ .def tosh = r25
+; xl = r26
+; xh = r27
+; yl = r28 ; StackPointer Ylo
+; yh = r29 ; StackPointer Yhi
+; zl = r30
+; zh = r31
+ .def t4 = r26
+ .def t5 = r27
+ .def t6 = r30
+ .def t7 = r31
+
+; Macros
+.macro poptos
+ ld tosl, Y+
+ ld tosh, Y+
+.endmacro
+
+.macro pushtos
+ st -Y, tosh
+ st -Y, tosl
+.endmacro
+
+.macro in_
+.if (@1 < $40)
+ in @0,@1
+.else
+ lds @0,@1
+.endif
+.endmacro
+
+.macro out_
+.if (@0 < $40)
+ out @0,@1
+.else
+ sts @0,@1
+.endif
+.endmacro
+
+.macro sbi_
+.if (@0 < $40)
+ sbi @0,@1
+.else
+ in_ @2,@0
+ ori @2,exp2(@1)
+ out_ @0,@2
+.endif
+.endmacro
+
+.macro cbi_
+.if (@0 < $40)
+ cbi @0,@1
+.else
+ in_ @2,@0
+ andi @2,~(exp2(@1))
+ out_ @0,@2
+.endif
+.endmacro
+
+.macro lpm_
+.if (FLASHEND < 0x8000) ; Word address
+ lpm @0,@1
+.else
+ elpm @0,@1
+.endif
+.endmacro
+
+.macro sub_pflash_z
+.if (PFLASH > 0)
+ subi zh, high(PFLASH)
+.endif
+.endmacro
+
+.macro add_pflash_z
+.if (PFLASH > 0)
+ subi zh, high(0x10000-PFLASH)
+.endif
+.endmacro
+
+.macro sub_pflash_tos
+.if (PFLASH > 0)
+ subi tosh, high(PFLASH)
+.endif
+.endmacro
+
+.macro add_pflash_tos
+.if (PFLASH > 0)
+ subi tosh, high(0x10000-PFLASH)
+.endif
+.endmacro
+
+.macro rampv_to_c
+.if (FLASHEND >= 0x8000)
+ bset 0
+.else
+ bclr 0
+.endif
+.endmacro
+
+.macro fdw
+ .dw ((@0<<1)+PFLASH)
+.endmacro
+
+.macro m_pop_zh
+.ifdef EIND
+ pop zh
+.endif
+.endmacro
+.macro m_pop_xh
+.ifdef EIND
+ pop xh
+ .endif
+.endmacro
+.macro m_pop_t0
+.ifdef EIND
+ pop t0
+ .endif
+.endmacro
+.macro m_push_t0
+.ifdef EIND
+ push t0
+ .endif
+.endmacro
+.macro mijmp
+.ifdef EIND
+ eijmp
+.else
+ ijmp
+.endif
+.endmacro
+
+; Symbol naming compatilibity
+; UART0 symbols for Atmega32
+.ifndef UCSR0A
+.equ UCSR0A=UCSRA
+.equ UDR0_=UDR
+.equ UCSR0B=UCSRB
+.equ UCSR0C=UCSRC
+.equ RXEN0=RXEN
+.equ TXEN0=TXEN
+.equ RXCIE0=RXCIE
+.equ UCSZ00=UCSZ0
+.equ USBS0=USBS
+.equ UBRR0H=UBRRH
+.equ UBRR0L=UBRRL
+.equ URSEL_=0x80
+.else
+.equ UDR0_=UDR0
+.equ URSEL_=0
+.endif
+
+.ifndef SPMCSR
+.equ SPMCSR=SPMCR
+.endif
+
+.ifndef SPMEN
+.equ SPMEN=SELFPRGEN
+.endif
+
+.ifndef EEWE
+.equ EEWE=EEPE
+.endif
+
+.ifndef EEMWE
+.equ EEMWE=EEMPE
+.endif
+
+.if OPERATOR_UART == 1
+.equ OP_TX_=TX1_
+.equ OP_RX_=RX1_
+.equ OP_RXQ=RX1Q
+.else
+.if OPERATOR_UART == 0
+.equ OP_TX_=TX0_
+.equ OP_RX_=RX0_
+.equ OP_RXQ=RX0Q
+.endif
+.endif
+
+#define ubrr0val (FREQ_OSC/16/BAUDRATE0) - 1
+#define ubrr1val (FREQ_OSC/16/BAUDRATE1) - 1
+
+.if FREQ_OSC < 16384000 ; Hz
+.equ ms_value_tmr0 = ((FREQ_OSC/1000/64) - 1)
+.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1)
+.equ ms_value_tmr2 = ((FREQ_OSC/1000/64) - 1)
+.ifdef TCCR0B
+.equ ms_pre_tmr0 = 3
+.endif
+.ifdef TCCR0
+.equ ms_pre_tmr0 = 4
+.endif
+.ifdef TCCR2B
+.equ ms_pre_tmr2 = 4
+.endif
+.ifdef TCCR2
+.equ ms_pre_tmr2 = 3
+.endif
+
+.else ; FREQ_OSC >= 16384000 Hz
+
+.equ ms_value_tmr0 = ((FREQ_OSC/1000/256) - 1)
+.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1)
+.equ ms_value_tmr2 = ((FREQ_OSC/1000/128) - 1)
+.ifdef TCCR0B
+.equ ms_pre_tmr0 = 4
+.endif
+.ifdef TCCR0
+.equ ms_pre_tmr0 = 6
+.endif
+.ifdef TCCR2B
+.equ ms_pre_tmr2 = 5
+.endif
+.ifdef TCCR2
+.equ ms_pre_tmr2 = 4
+.endif
+.endif
+.equ CPU_LOAD_VAL = (FREQ_OSC*255/100000)
+;..............................................................................
+;Program Specific Constants (literals used in code)
+;..............................................................................
+; Flash page size
+.equ PAGESIZEB=PAGESIZE*2 ; Page size in bytes
+
+; Forth word header flags
+.equ NFA= 0x80 ; Name field mask
+.equ IMMED= 0x40 ; Immediate mask
+.equ INLINE= 0x20 ; Inline mask for 1 and 2 cell code
+.equ INLINE4= 0x00 ; Inline mask for 4 cell code
+.equ INLINE5= 0x00 ; Inline mask for 5 cell code
+.equ COMPILE= 0x10 ; Compile only mask
+.equ NFAmask= 0xf ; Name field length mask
+
+; FLAGS2
+.equ fIDLE= 6 ; 0 = busy, 1 = idle
+.equ fLOAD= 5 ; Load measurement ready
+.equ fLOADled= 4 ; 0 = no load led, 1 = load led on
+.equ fFC_tx1= 3 ; 0=Flow Control, 1 = no Flow Control
+.equ fFC_tx0= 2 ; 0=Flow Control, 1 = no Flow Control
+.equ ixoff_tx1= 1
+.equ ixoff_tx0= 0
+
+; FLAGS1
+.equ fLIT= 7 ; Literal compiled
+.equ noclear= 6 ; dont clear optimisation flags
+.equ idup= 5 ; Use dupzeroequal instead of zeroequal
+.equ izeroeq= 4 ; Use brne instead of breq if zeroequal
+.equ istream= 3
+.equ fLOCK= 2
+.equ fTAILC= 1
+.equ idirty= 0
+
+;;; For Flow Control
+.equ XON= 0x11
+.equ XOFF= 0x13
+
+.equ CR_=0x0d
+.equ LF_=0x0a
+.equ BS_=0x08
+.equ TAB_=0x09
+
+;;; Memory mapping prefixes
+.equ PRAM = 0x0000 ; 8 Kbytes of ram (atm2560)
+.equ PEEPROM = RAMEND+1 ; 4 Kbytes of eeprom (atm2560)
+.if (FLASHEND == 0x1ffff) ; 128 Kwords flash
+.equ OFLASH = PEEPROM+EEPROMEND+1 ; 52 Kbytes available for FlashForth(atm2560)
+.equ PFLASH = 0
+.equ RAMPZV = 3
+.equ KERNEL_SIZE=0x0d80
+.else
+.if (FLASHEND == 0xffff) ; 64 Kwords flash
+.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth(atm128)
+.equ PFLASH = 0
+.equ RAMPZV = 1
+.equ KERNEL_SIZE=0x0d00
+.else
+.if (FLASHEND == 0x7fff) ; 32 Kwords flash
+.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth
+.equ PFLASH = 0
+.equ RAMPZV = 0
+.equ KERNEL_SIZE=0x0d00
+.else
+.if (FLASHEND == 0x3fff) ; 16 Kwords flash
+.equ OFLASH = 0x8000 ; 32 Kbytes available for FlashForth
+.equ PFLASH = OFLASH
+.equ RAMPZV = 0
+.equ KERNEL_SIZE=0x0c80
+.else
+.if (FLASHEND == 0x1fff) ; 8 Kwords flash
+.equ OFLASH = 0xC000 ; 16 Kbytes available for FlashForth
+.equ PFLASH = OFLASH
+.equ RAMPZV = 0
+.equ KERNEL_SIZE=0x0c80
+.endif
+.endif
+.endif
+.endif
+.endif
+.equ BOOT_SIZE=0x400
+.equ BOOT_START=FLASHEND - BOOT_SIZE + 1 ; atm128: 0xfc00, atm328: 0x3c00
+.equ KERNEL_START=BOOT_START - KERNEL_SIZE
+
+;;; High values for memory areas
+.equ FLASH_HI = 0xffff - (BOOT_SIZE*2) - (KERNEL_SIZE*2)
+.equ EEPROM_HI =PEEPROM + EEPROMEND
+.equ RAM_HI = RAMEND
+
+;;; USER AREA for the OPERATOR task
+.equ ursize= RETURN_STACK_SIZE
+.equ ussize= PARAMETER_STACK_SIZE
+.equ utibsize= TIB_SIZE
+
+;;; User variables and area
+.equ us0= -28 ; Start of parameter stack
+.equ ur0= -26 ; Start of ret stack
+.equ uemit= -24 ; User EMIT vector
+.equ ukey= -22 ; User KEY vector
+.equ ukeyq= -20 ; User KEY? vector
+.equ ubase= -18 ; Number Base
+.equ utib= -16 ; TIB address
+.equ utask= -14 ; Task area pointer
+.equ ustatus= -12
+.equ uflg= -11
+.equ usource= -10 ; Two cells
+.equ utoin= -6 ; Input stream
+.equ ulink= -4 ; Task link
+.equ ursave= -2 ; Saved ret stack pointer
+.equ uhp= 0 ; Hold pointer
+
+
+;;; Variables in EEPROM
+.equ eeprom= PEEPROM
+.equ dp_start= eeprom + 0x0000 ; TURNKEY
+.equ dp_flash= eeprom + 0x0002 ; FLASH dictionary pointer
+.equ dp_eeprom= eeprom + 0x0004 ; EEPROM dictionary pointer
+.equ dp_ram= eeprom + 0x0006 ; RAM dictionary pointer
+.equ latest= eeprom + 0x0008 ; Pointer to latest dictionary word
+.equ prompt= eeprom + 0x000a ; Deferred prompt
+.equ ehere= eeprom + 0x000c
+
+;****************************************************
+.dseg
+ibuf: .byte PAGESIZEB
+ivec: .byte INT_VECTORS_SIZE
+
+rxqueue0:
+rbuf0_wr: .byte 1
+rbuf0_rd: .byte 1
+rbuf0_lv: .byte 1
+rbuf0: .byte RX0_BUF_SIZE
+
+.ifdef UCSR1A
+rxqueue1:
+rbuf1_wr: .byte 1
+rbuf1_rd: .byte 1
+rbuf1_lv: .byte 1
+rbuf1: .byte RX1_BUF_SIZE
+.endif
+
+litbuf0: .byte 1
+litbuf1: .byte 1
+
+dpSTART: .byte 2
+dpFLASH: .byte 2 ; DP's and LATEST in RAM
+dpEEPROM: .byte 2
+dpRAM: .byte 2
+dpLATEST: .byte 2
+
+iaddrl: .byte 1
+iaddrh: .byte 1
+.ifdef RAMPZ
+iaddru: .byte 1
+ibaseu: .byte 1
+.endif
+
+.if IDLE_MODE == 1
+.if CPU_LOAD == 1
+load_acc: .byte 3 ; Load measurement accumulator
+load_res: .byte 3 ; Load result
+.endif
+.endif
+
+cse: .byte 1 ; Current data section 0=flash, 1=eeprom, 2=ram
+state: .byte 1 ; Compilation state
+uvars: .byte (-us0)
+up0: .byte 2
+urbuf: .byte ursize
+usbuf: .byte ussize
+utibbuf: .byte utibsize
+dpdata: .byte 2
+
+.eseg
+.org 0
+ .dw 0xffff ; Force first cell of eeprom to 0xffff
+;*******************************************************************
+; Start of kernel
+;*******************************************************************
+.cseg
+.if (FLASHEND == 0x1ffff)
+.org 0x17e80
+.else
+.org KERNEL_START
+.endif
+;***********************************************************
+CMP:
+ call TOR
+ rjmp CMP2
+CMP1:
+ call NEQUALSFETCH
+ call MINUS
+ call ZEROSENSE
+ breq CMP2
+ jmp TWODROPZ
+CMP2:
+ call XNEXT
+ brcc CMP1
+ jmp TWODROPNZ
+
+.if (FLASHEND == 0x1ffff)
+.org KERNEL_START+0x0
+.endif
+;;; *************************************************
+;;; WARM user area data
+.equ warmlitsize= 28
+WARMLIT:
+ .dw 0x0200 ; cse, state
+ .dw utibbuf-4 ; S0
+ .dw usbuf-1 ; R0
+ fdw OP_TX_
+ fdw OP_RX_
+ fdw OP_RXQ
+ .dw BASE_DEFAULT ; BASE
+ .dw utibbuf ; TIB
+ fdw OPERATOR_AREA ; TASK
+ .dw 0 ; ustatus & uflg
+ .dw 0 ; source
+ .dw 0 ; source
+ .dw 0 ; TOIN
+ .dw up0 ; Task link
+; M? -- caddr count current data space string
+; dw L_DOTBASE
+L_MEMQ:
+ .db NFA|1," "
+MEMQ:
+ call CSE_
+ call DOLIT
+ fdw MEMQADDR_N
+ call PLUS
+ call FETCH_A
+ call CFETCHPP
+ call DOLIT
+ .dw NFAmask
+ jmp AND_
+
+.if (FLASHEND == 0x1ffff)
+ fdw PAUSE_L
+WDON_L:
+ .db NFA|3,"wd+"
+WDON:
+ cli
+ wdr
+ lds tosh, WDTCSR
+ ori tosh, (1<<WDCE)|(1<<WDE)
+ sts WDTCSR, tosh
+ andi tosl, 7
+ ori tosl, (1<<WDE)
+ sts WDTCSR, tosl
+ sei
+ jmp DROP
+
+; WD- ( -- ) stop the watchdog
+ fdw WDON_L
+WDOFF_L:
+ .db NFA|3,"wd-"
+WDOFF:
+ cli
+ wdr
+.ifdef MCUSR
+ out MCUSR, r_zero
+.else
+ out MCUCSR, r_zero
+.endif
+ ldi t0, (1<<WDCE)|(1<<WDE)
+ sts WDTCSR, t0
+ sts WDTCSR, r_zero
+ sei
+ ret
+
+; WDR ( -- ) kick the dog
+ fdw WDOFF_L
+CWD_L:
+ .db NFA|INLINE|3,"cwd"
+CWD:
+ wdr
+ ret
+.endif
+;*********************************************************************
+; EXIT -- Compile a return
+; variable link
+ .dw 0
+EXIT_L:
+ .db NFA|4,"exit",0
+EXIT:
+ m_pop_t0
+ pop t0
+ pop t0
+ ret
+
+ fdw IFLUSH_L
+OPERATOR_L:
+ .db NFA|8,"operator",0
+OPERATOR:
+ call DOCREATE
+ fdw OPERATOR_AREA
+OPERATOR_AREA:
+ .dw up0
+ .dw 0, ursize
+ .dw ussize, utibsize
+
+; idle
+ fdw(EXIT_L)
+IDLE_L:
+ .db NFA|4,"idle",0
+IDLE:
+ sbr FLAGS2, (1<<fIDLE)
+ ret
+
+; busy
+ fdw(IDLE_L)
+BUSY_L:
+ .db NFA|4,"busy",0
+BUSY:
+ cbr FLAGS2, (1<<fIDLE)
+ ret
+; *********************************************
+; Bit masking 8 bits, only for ram addresses !
+; : mset ( mask addr -- )
+; dup >r c@ swap or r> c!
+; ;
+ fdw ICCOMMA_L
+MSET_L:
+ .db NFA|4,"mset",0
+MSET:
+ movw zl, tosl
+ poptos
+ ld t0, z
+ or t0, tosl
+ st z, t0
+ poptos
+ ret
+
+; : mclr ( mask addr -- )
+; dup >r c@ swap invert and r> c!
+; ;
+ fdw MSET_L
+MCLR_L:
+ .db NFA|4,"mclr",0
+MCLR_:
+ movw zl, tosl
+ poptos
+ ld t0, z
+ com tosl
+ and t0, tosl
+ st z, t0
+ poptos
+ ret
+
+; LSHIFT x1 u -- x2
+ fdw MCLR_L
+LSHIFT_L:
+ .db NFA|6,"lshift",0
+LSHIFT:
+ movw zl, tosl
+ poptos
+LSHIFT1:
+ sbiw zl, 1
+ brmi LSHIFT2
+ lsl tosl
+ rol tosh
+ rjmp LSHIFT1
+LSHIFT2:
+ ret
+
+; RSHIFT x1 u -- x2
+ fdw LSHIFT_L
+RSHIFT_L:
+ .db NFA|6,"rshift",0
+RSHIFT:
+ movw zl, tosl
+ poptos
+RSHIFT1:
+ sbiw zl, 1
+ brmi RSHIFT2
+ lsr tosh
+ ror tosl
+ rjmp RSHIFT1
+RSHIFT2:
+ ret
+
+;**********************************************
+NEQUALSFETCH:
+ rcall CFETCHPP
+ rcall ROT
+ rcall CFETCHPP
+ rjmp ROT
+;***************************************************
+; N= c-addr nfa -- n string:name cmp
+; n=0: s1==s2, n=ffff: s1!=s2
+; N= is specificly used for finding dictionary entries
+; It can also be used for comparing strings shorter than 16 characters,
+; but the first string must be in ram and the second in program memory.
+ fdw RSHIFT_L
+NEQUAL_L:
+ .db NFA|2,"n=",0
+NEQUAL:
+ rcall NEQUALSFETCH
+ andi tosl, 0xf
+ rcall EQUAL
+ rcall ZEROSENSE
+ breq NEQUAL5
+ rcall ONEMINUS
+ rcall CFETCHPP
+ rcall TOR
+ rjmp NEQUAL4
+NEQUAL2:
+ rcall NEQUALSFETCH
+ rcall NOTEQUAL
+ rcall ZEROSENSE
+ breq NEQUAL3
+ rcall TRUE_
+ call LEAVE
+ rjmp NEQUAL4
+NEQUAL3:
+ rcall RFETCH
+ rcall ZEROSENSE
+ brne NEQUAL4
+ rcall FALSE_
+NEQUAL4:
+ call XNEXT
+ brcc NEQUAL2
+ pop t1
+ pop t0
+ rjmp NEQUAL6
+NEQUAL5:
+ rcall TRUE_
+NEQUAL6:
+ rcall NIP
+ jmp NIP
+
+; SKIP c-addr u c -- c-addr' u'
+; skip matching chars
+; u (count) must be smaller than 256
+ fdw NEQUAL_L
+SKIP_L:
+ .db NFA|4,"skip",0
+SKIP:
+
+ rcall TOR
+SKIP0:
+ rcall DUPZEROSENSE
+ breq SKIP2
+
+ rcall OVER
+ rcall CFETCH_A
+
+ rcall DUP
+ rcall DOLIT
+ .dw TAB_
+ rcall EQUAL
+ rcall ZEROSENSE
+ brne SKIP05
+ rcall RFETCH
+ rcall EQUAL
+ rcall ZEROSENSE
+ breq SKIP2
+ rjmp SKIP1
+SKIP05:
+ rcall DROP
+SKIP1:
+ rcall ONE
+ rcall SLASHSTRING
+ rjmp SKIP0
+SKIP2:
+ pop t0
+ pop t0
+ ret
+
+
+; SCAN c-addr u c -- c-addr' u'
+; find matching chars
+
+
+ fdw SKIP_L
+SCAN_L:
+ .db NFA|4,"scan",0
+SCAN:
+ rcall STORE_P_TO_R
+ rcall TOR
+ rjmp SCAN3
+SCAN1:
+ rcall CFETCHPP
+ rcall DUP
+ rcall DOLIT
+ .dw TAB_
+ rcall EQUAL
+ rcall ZEROSENSE
+ breq SCAN2
+ rcall DROP
+ rjmp SCAN25
+SCAN2:
+ call FETCH_P
+ rcall EQUAL
+ rcall ZEROSENSE
+ breq SCAN3
+SCAN25:
+ rcall ONEMINUS
+ rjmp SCAN4
+SCAN3:
+ call XNEXT
+ brcc SCAN1
+SCAN4:
+ rcall RFROM
+ rcall ONEPLUS
+ rcall R_TO_P
+ ret
+
+; : mtst ( mask addr -- flag )
+; c@ and
+; ;
+ fdw SCAN_L
+MTST_L:
+ .db NFA|4,"mtst",0
+MTST:
+ movw zl, tosl
+ ld tosl, z+
+ ld t0, Y+
+ ld t1, Y+
+ and tosl, t0
+ clr tosh
+ ret
+
+
+ fdw MTST_L
+FCY_L:
+ .db NFA|3,"Fcy"
+ rcall DOCREATE
+ .dw FREQ_OSC / 1000
+
+;;; Check parameter stack pointer
+ .db NFA|3,"sp?"
+check_sp:
+ rcall SPFETCH
+ call R0_
+ rcall FETCH_A
+ call S0
+ rcall FETCH_A
+ rcall ONEPLUS
+ rcall WITHIN
+ rcall XSQUOTE
+ .db 3,"SP?"
+ rcall QABORT
+ ret
+;***************************************************
+; EMIT c -- output character to the emit vector
+ fdw FCY_L
+EMIT_L:
+ .db NFA|4,"emit",0
+EMIT:
+ rcall UEMIT_
+ jmp FEXECUTE
+
+;***************************************************
+; KEY -- c get char from UKEY vector
+ fdw EMIT_L
+KEY_L:
+ .db NFA|3,"key"
+KEY:
+ rcall UKEY_
+ jmp FEXECUTE
+
+;***************************************************
+; KEY -- c get char from UKEY vector
+ fdw KEY_L
+KEYQ_L:
+ .db NFA|4,"key?",0
+KEYQ:
+ rcall UKEYQ_
+ jmp FEXECUTE
+
+ fdw KEYQ_L
+EXECUTE_L:
+ .db NFA|7,"execute"
+EXECUTE:
+ movw zl, tosl
+ sub_pflash_z
+ poptos
+ rampv_to_c
+ ror zh
+ ror zl
+ mijmp
+
+ fdw EXECUTE_L
+FEXECUTE_L:
+ .db NFA|3,"@ex"
+FEXECUTE:
+ rcall FETCH_A
+ jmp EXECUTE
+
+ fdw FEXECUTE_L
+VARIABLE_L:
+ .db NFA|8,"variable",0
+VARIABLE_:
+ rcall HERE
+ rcall CELL
+ rcall ALLOT
+ jmp CONSTANT_
+
+ fdw VARIABLE_L
+TWOVARIABLE_L:
+ .db NFA|9,"2variable"
+TWOVARIABLE_:
+ rcall HERE
+ rcall DOLIT
+ .dw 0x4
+ rcall ALLOT
+ jmp CONSTANT_
+
+ fdw TWOVARIABLE_L
+CONSTANT_L:
+ .db NFA|8,"constant",0
+CONSTANT_:
+ rcall COLON
+ call LITERAL
+ jmp SEMICOLON
+
+ fdw CONSTANT_L
+TWOCONSTANT_L:
+ .db NFA|9,"2constant"
+TWOCONSTANT_:
+ rcall SWOP
+ rcall COLON
+ call LITERAL
+ call LITERAL
+ jmp SEMICOLON
+
+; DOCREATE, code action of CREATE
+; Fetch the next cell from program memory to the parameter stack
+DOCREATE_L:
+ .db NFA|3, "(c)"
+DOCREATE:
+ m_pop_zh
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ m_pop_zh
+ pop zh
+ pop zl
+ mijmp
+
+;;; Resolve the runtime action of the word created by using does>
+DODOES_L:
+ .db NFA|3, "(d)"
+DODOES:
+ m_pop_xh
+ pop xh
+ pop xl
+ m_pop_zh
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ movw z, x
+ mijmp ; (z)
+
+FETCHLIT:
+ pushtos
+ lsl zl
+ rol zh
+ lpm_ tosl, z+
+ lpm_ tosh, z+
+ ret
+
+ .db NFA|3, "(,)"
+DOCOMMAXT:
+ m_pop_t0
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ ror zh
+ ror zl
+ push zl
+ push zh
+ m_push_t0
+ rjmp COMMAXT
+
+; SP@ -- addr get parameter stack pointer
+ fdw TWOCONSTANT_L
+SPFETCH_L:
+ .db NFA|3,"sp@"
+SPFETCH:
+ movw z, y
+ pushtos
+ movw tosl, z
+ ret
+
+; SP! addr -- store stack pointer
+ .db NFA|3,"sp!"
+SPSTORE:
+ movw y, tosl
+ ret
+
+; RPEMPTY -- EMPTY THE RETURN STACK
+ .db NFA|3,"rp0"
+RPEMPTY:
+ m_pop_xh
+ pop xh
+ pop xl
+ call R0_
+ rcall FETCH_A
+ out spl, tosl
+ out sph, tosh
+ poptos
+ movw zl, xl
+ mijmp
+
+; RP@ Fetch the return stack pointer
+ fdw SPFETCH_L
+RPFETCH_L:
+ .db NFA|INLINE|COMPILE|3,"rp@"
+RPFETCH:
+ pushtos
+ in tosl, spl
+ in tosh, sph
+ ret
+
+; >< Swap bytes
+ fdw RPFETCH_L
+SWAPB_L:
+ .db NFA|INLINE|2,"><",0
+SWAPB:
+ mov t0, tosl
+ mov tosl, tosh
+ mov tosh, t0
+ ret
+
+; DICTIONARY POINTER FOR the current section
+; Flash -- sets the data section to flash
+ fdw SWAPB_L
+FLASH_L:
+ROM_N:
+ .db NFA|5,"flash"
+ROM_:
+ sts cse, r_zero
+ ret
+
+; EEPROM -- sets the data section to EEPROM data memory
+ fdw FLASH_L
+EEPROM_L:
+EROM_N:
+ .db NFA|6,"eeprom",0
+EROM:
+ sts cse, r_two
+ ret
+
+; RAM -- sets the data section to RAM memory
+ fdw EEPROM_L
+RAM_L:
+FRAM_N:
+ .db NFA|3,"ram"
+FRAM:
+ ldi t0, 4
+ sts cse, t0
+ ret
+
+; DP -- a-addr
+; Fetched from EEPROM
+ fdw RAM_L
+DP_L:
+ .db NFA|2,"dp",0
+DP:
+ rcall IDP
+ rcall CSE_
+ jmp PLUS
+
+
+;;;
+ .db NFA|3,"cse"
+CSE_:
+ pushtos
+ lds tosl, cse
+ clr tosh
+ ret
+
+; HERE -- addr get current data space ptr
+; DP @ ;
+ fdw DP_L
+HERE_L:
+ .db NFA|4,"here",0
+HERE:
+ rcall DP
+ jmp FETCH
+
+; , x -- append cell to current data space
+; HERE ! CELL ALLOT ;
+ fdw HERE_L
+COMMA_L:
+ .db NFA|1,","
+COMMA:
+ rcall HERE
+ rcall STORE_A
+ rcall CELL
+ jmp ALLOT
+
+; C, c -- append char to current data space
+; HERE C! 1 ALLOT ;
+ fdw COMMA_L
+CCOMMA_L:
+ .db NFA|2,"c,",0
+CCOMMA:
+ rcall HERE
+ rcall CSTORE_A
+ rcall ONE
+ jmp ALLOT
+
+
+; CELL -- n size of one cell
+ fdw CCOMMA_L
+CELL_L:
+ .db NFA|4,"cell",0
+CELL:
+ pushtos
+ ldi tosl, 2
+ ldi tosh, 0
+ ret
+
+; ALIGN -- align DP
+ fdw CELL_L
+ALIGN_L:
+ .db NFA|5,"align"
+ALIGN:
+ rcall HERE
+ rcall ALIGNED
+ rcall DP
+ jmp STORE
+
+; ALIGNED addr -- a-addr align given addr
+ fdw ALIGN_L
+ALIGNED_L:
+ .db NFA|7,"aligned"
+ALIGNED:
+ adiw tosl, 1
+ cbr tosl, 1
+ ret
+
+; CELL+ a-addr1 -- a-addr2 add cell size
+; 2 + ;
+ fdw ALIGNED_L
+CELLPLUS_L:
+ .db NFA|INLINE|5,"cell+"
+CELLPLUS:
+ adiw tosl, 2
+ ret
+
+; CELLS n1 -- n2 cells->adrs units
+ fdw CELLPLUS_L
+CELLS_L:
+ .db NFA|INLINE|5,"cells"
+CELLS:
+ lsl tosl
+ rol tosh
+ ret
+
+; CHAR+ c-addr1 -- c-addr2 add char size
+ fdw CELLS_L
+CHARPLUS_L:
+ .db NFA|INLINE|5,"char+"
+CHARPLUS:
+ adiw tosl, 1
+ ret
+
+; CHARS n1 -- n2 chars->adrs units
+ fdw CHARPLUS_L
+CHARS_L:
+ .db NFA|INLINE|5,"chars"
+CHARS: ret
+
+ fdw CHARS_L
+COMMAXT_L:
+ .db NFA|3, "cf,"
+COMMAXT:
+ rcall DUP
+ rcall IHERE
+ rcall MINUS
+ rcall ABS_
+ rcall DOLIT
+ .dw 0xff0
+ rcall GREATER
+ rcall ZEROSENSE
+ breq STORECF1
+STORECFF1:
+; rcall CALL_
+ rcall DOLIT
+.ifdef EIND
+ .dw 0x940F ; On Atmega 2560 all code is on 128 - 256 Kword area.
+.else
+ .dw 0x940E ; call jmp:0x940d
+.endif
+ call ICOMMA
+ sub_pflash_tos
+ rampv_to_c
+ ror tosh
+ ror tosl
+ rjmp STORECF2
+STORECF1:
+ rcall IHERE
+ rcall MINUS
+ rcall TWOMINUS
+ rcall TWOSLASH
+ ;rcall RCALL_
+ andi tosh, 0x0f
+ ori tosh, 0xd0
+STORECF2:
+ jmp ICOMMA
+
+
+; !COLON -- change code field to docolon
+; -6 IALLOT ;
+; .dw link
+;link set $
+ .db NFA|2,"!:",0
+STORCOLON:
+ rcall DOLIT
+ .dw 0xfffa ; -6
+ jmp IALLOT
+
+
+; 2@ a-addr -- x1 x2 fetch 2 cells
+; DUP @ SWAP CELL+ @ ;
+; the lower address will appear on top of stack
+ fdw COMMAXT_L
+TWOFETCH_L:
+ .db NFA|2,"2@",0
+TWOFETCH:
+ rcall DUP
+ rcall FETCH_A
+ rcall SWOP
+ rcall CELLPLUS
+ jmp FETCH_A
+
+; 2! x1 x2 a-addr -- store 2 cells
+; SWAP OVER ! CELL+ ! ;
+; the top of stack is stored at the lower adrs
+ fdw TWOFETCH_L
+TWOSTORE_L:
+ .db NFA|2,"2!",0
+TWOSTORE:
+ rcall SWOP
+ rcall OVER
+ rcall CELLPLUS
+ rcall STORE_A
+ jmp STORE
+
+; 2DROP x1 x2 -- drop 2 cells
+; DROP DROP ;
+ fdw TWOSTORE_L
+TWODROP_L:
+ .db NFA|5,"2drop"
+TWODROP:
+ rcall DROP
+ jmp DROP
+
+; 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells
+; OVER OVER ;
+ fdw TWODROP_L
+TWODUP_L:
+ .db NFA|4,"2dup",0
+TWODUP:
+ rcall OVER
+ jmp OVER
+
+; 2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 dup top 2 cells
+ fdw TWODUP_L
+TWOSWAP_L:
+ .db NFA|5,"2swap"
+TWOSWAP:
+ rcall ROT
+ rcall TOR
+ rcall ROT
+ rcall RFROM
+ ret
+
+; INPUT/OUTPUT ==================================
+
+; SPACE -- output a space
+; BL EMIT ;
+ fdw TWOSWAP_L
+SPACE_L:
+ .db NFA|5,"space"
+SPACE_:
+ rcall BL
+ jmp EMIT
+
+; SPACES n -- output n spaces
+; BEGIN DUP WHILE SPACE 1- REPEAT DROP ;
+ fdw SPACE_L
+SPACES_L:
+ .db NFA|6,"spaces",0
+SPACES:
+SPCS1:
+ rcall DUPZEROSENSE
+ breq SPCS2
+ rcall SPACE_
+ rcall ONEMINUS
+ rjmp SPCS1
+SPCS2: jmp DROP
+
+
+; umin u1 u2 -- u unsigned minimum
+; 2DUP U> IF SWAP THEN DROP ;
+ fdw SPACES_L
+UMIN_L:
+ .db NFA|4,"umin",0
+UMIN:
+ rcall TWODUP
+ rcall UGREATER
+ rjmp MINMAX
+
+; umax u1 u2 -- u unsigned maximum
+; 2DUP U< IF SWAP THEN DROP ;
+ fdw UMIN_L
+UMAX_L:
+ .db NFA|4,"umax",0
+UMAX:
+ rcall TWODUP
+ rcall ULESS
+MINMAX:
+ rcall ZEROSENSE
+ breq UMAX1
+ rcall SWOP
+UMAX1: jmp DROP
+
+ fdw UMAX_L
+ONE_L:
+ .db NFA|INLINE4|1,"1"
+ONE:
+ pushtos
+ ldi tosl, 1
+ ldi tosh, 0
+ ret
+
+; ACCEPT c-addr +n -- +n' get line from terminal
+ fdw ONE_L
+ACCEPT_L:
+ .db NFA|6,"accept",0
+ACCEPT:
+ rcall OVER
+ rcall PLUS
+ rcall OVER
+ACC1:
+ rcall KEY
+
+ cpi tosl, CR_
+ brne ACC_LF
+
+ rcall TRUE_
+ rcall FCR
+ rcall CSTORE_A
+ rcall DROP
+ rjmp ACC6
+ACC_LF:
+ cpi tosl, LF_
+ brne ACC2
+ rcall DROP
+
+ rcall FCR
+ rcall CFETCH_A
+ rcall ZEROSENSE
+ breq ACC6
+ rcall FALSE_
+ rcall FCR
+ rcall CSTORE_A
+ rjmp ACC1
+ACC2:
+ rcall FALSE_
+ rcall FCR
+ rcall CSTORE_A
+ rcall DUP
+ rcall EMIT
+ rcall DUP
+ rcall DOLIT
+ .dw BS_
+ rcall EQUAL
+ rcall ZEROSENSE
+ breq ACC3
+ rcall DROP
+ rcall ONEMINUS
+ rcall TOR
+ rcall OVER
+ rcall RFROM
+ rcall UMAX
+ rjmp ACC1
+ACC3:
+ rcall OVER
+ rcall CSTORE_A
+ rcall ONEPLUS
+ rcall OVER
+ rcall UMIN
+ rcall TWODUP
+ rcall NOTEQUAL
+ rcall ZEROSENSE
+ brne ACC1
+ACC6:
+ rcall NIP
+ rcall SWOP
+ jmp MINUS
+
+ .db NFA|3,"fcr"
+FCR:
+ rcall DOUSER
+ .dw uflg
+
+
+; TYPE c-addr u -- type line to terminal u < $100
+; : type for c@+ emit next drop ;
+
+ fdw ACCEPT_L
+TYPE_L:
+ .db NFA|4,"type",0
+TYPE:
+ rcall TOR
+ rjmp TYPE2 ; XFOR
+TYPE1:
+ rcall CFETCHPP
+ rcall EMIT
+TYPE2:
+ call XNEXT
+ brcc TYPE1
+ pop t1
+ pop t0
+ jmp DROP
+
+
+; (S" -- c-addr u run-time code for S"
+ .db NFA|3,"(s",0x22
+XSQUOTE:
+ m_pop_zh
+ pop zh
+ pop zl
+ lsl zl
+ rol zh
+ lpm_ t0, z+
+ pushtos
+ movw tosl, zl
+ add_pflash_tos
+ pushtos
+ mov tosl, t0
+ clr tosh
+ add zl, t0
+ adc zh, tosh
+ adiw zl, 1
+ rampv_to_c
+ ror zh
+ ror zl
+ mijmp
+
+ fdw TYPE_L
+SQUOTE_L:
+ .db NFA|IMMED|COMPILE|2,"s",0x22,0
+SQUOTE:
+ rcall DOCOMMAXT
+ fdw XSQUOTE
+ rcall ROM_
+ rcall CQUOTE
+ jmp FRAM
+
+ fdw SQUOTE_L
+CQUOTE_L:
+ .db NFA|2,",",0x22,0
+CQUOTE:
+ rcall DOLIT
+ .dw 0x22
+ rcall PARSE
+ rcall HERE
+ rcall OVER
+ rcall ONEPLUS
+ rcall ALIGNED
+ rcall ALLOT
+ jmp PLACE
+
+
+ fdw CQUOTE_L
+DOTQUOTE_L:
+ .db NFA|IMMED|COMPILE|2,".",0x22,0
+DOTQUOTE:
+ rcall SQUOTE
+ rcall DOCOMMAXT
+ fdw TYPE
+ ret
+
+ fdw DOTQUOTE_L
+ALLOT_L:
+ .db NFA|5,"allot"
+ALLOT:
+ rcall DP
+ jmp PLUSSTORE
+
+ fdw ALLOT_L
+DROP_L:
+ .db NFA|INLINE|4,"drop",0
+DROP:
+ poptos
+ ret
+
+ fdw DROP_L
+SWOP_L:
+ .db NFA|INLINE5|4,"swap",0
+SWOP:
+ ld t0, y+
+ ld t1, y+
+ pushtos
+ movw tosl, t0
+ ret
+
+ fdw SWOP_L
+OVER_L:
+ .db NFA|INLINE4|4,"over",0
+OVER:
+ pushtos
+ ldd tosl, y+2
+ ldd tosh, y+3
+ ret
+
+ fdw OVER_L
+ROT_L:
+ .db NFA|3, "rot"
+ROT:
+ rcall TOR
+ rcall SWOP
+ rcall RFROM
+ jmp SWOP
+
+ fdw ROT_L
+TOR_L:
+ .db NFA|COMPILE|2,">r",0
+TOR:
+ m_pop_zh
+ pop zh
+ pop zl
+ push tosl
+ push tosh
+ poptos
+ mijmp
+
+ fdw TOR_L
+RFROM_L:
+ .db NFA|COMPILE|2,"r>",0
+RFROM:
+ m_pop_zh
+ pop zh
+ pop zl
+ pushtos
+ pop tosh
+ pop tosl
+ mijmp
+
+ fdw RFROM_L
+RFETCH_L:
+ .db NFA|COMPILE|2,"r@",0
+RFETCH:
+ m_pop_zh
+ pop zh
+ pop zl
+ pushtos
+ pop tosh
+ pop tosl
+ push tosl
+ push tosh
+ mijmp
+
+; ABS n --- n1 absolute value of n
+ fdw DUP_L
+ABS_L:
+ .db NFA|3,"abs"
+ABS_:
+ rcall DUP
+ jmp QNEGATE
+
+ fdw ABS_L
+PLUS_L:
+ .db NFA|INLINE4|1, "+"
+
+PLUS:
+ ld t0, Y+
+ ld t1, Y+
+ add tosl, t0
+ adc tosh, t1
+ ret
+
+; m+ ( d n -- d1 )
+ fdw PLUS_L
+MPLUS_L:
+ .db NFA|2, "m+",0
+MPLUS:
+ rcall STOD
+ jmp DPLUS
+
+ fdw MPLUS_L
+MINUS_L:
+ .db NFA|INLINE5|1, "-"
+MINUS:
+ ld t0, Y+
+ ld t1, Y+
+ sub t0, tosl
+ sbc t1, tosh
+ movw tosl, t0
+ ret
+
+FROM_LITBUF:
+ lds r0, litbuf0
+ lds r1, litbuf1
+ ret
+PLUSC_:
+ rcall FROM_LITBUF
+ com r0
+ com r1
+ add r0, r_one
+ adc r1, r_zero
+ rcall ANDIC1
+ rjmp MINUSC_1
+MINUSC_:
+ rcall ANDIC0
+MINUSC_1:
+ ori tosh, 0x50
+ rcall ICOMMA_
+ rcall DUP
+ mov tosl, r1
+ rcall ANDIC2
+ ori tosl, 0x90
+ ori tosh, 0x40
+ rjmp ICOMMA_
+ANDIC0:
+ rcall FROM_LITBUF
+ANDIC1:
+ rcall IDPMINUS
+ rcall IDPMINUS
+ mov tosl, r0
+ANDIC2:
+ mov tosh, tosl
+ swap tosh
+ andi tosl, 0x0f
+ andi tosh, 0x0f
+ ori tosl, 0x80
+ ret
+ANDIC_:
+ rcall ANDIC0
+ ori tosh, 0x70
+ rcall ICOMMA_
+ rcall DUP
+ mov tosl, r1
+ rcall ANDIC2
+ ori tosl, 0x90
+ ori tosh, 0x70
+ rjmp ICOMMA_
+ORIC_:
+ rcall ANDIC0
+ ori tosh, 0x60
+ rcall ICOMMA_
+ rcall DUP
+ mov tosl, r1
+ rcall ANDIC2
+ ori tosl, 0x90
+ ori tosh, 0x60
+ICOMMA_:
+ jmp ICOMMA
+
+ fdw MINUS_L
+AND_L:
+ .db NFA|INLINE4|3, "and"
+AND_:
+ ld t0, Y+
+ ld t1, Y+
+ and tosl, t0
+ and tosh, t1
+ ret
+
+ fdw AND_L
+OR_L:
+ .db NFA|INLINE4|2, "or",0
+OR_:
+ ld t0, Y+
+ ld t1, Y+
+ or tosl, t0
+ or tosh, t1
+ ret
+
+ fdw OR_L
+XOR_L:
+ .db NFA|INLINE4|3, "xor"
+XOR_:
+ ld t0, Y+
+ ld t1, Y+
+ eor tosl, t0
+ eor tosh, t1
+ ret
+
+ fdw XOR_L
+INVERT_L:
+ .db NFA|INLINE|6, "invert",0
+INVERT:
+ com tosl
+ com tosh
+ ret
+
+ fdw INVERT_L
+NEGATE_L:
+ .db NFA|6, "negate",0
+NEGATE:
+ com tosl
+ com tosh
+ adiw tosl, 1
+ ret
+
+ fdw NEGATE_L
+ONEPLUS_L:
+ .db NFA|INLINE|2, "1+",0
+ONEPLUS:
+ adiw tosl, 1
+ ret
+
+ fdw ONEPLUS_L
+ONEMINUS_L:
+ .db NFA|INLINE|2, "1-",0
+ONEMINUS:
+ sbiw tosl, 1
+ ret
+
+ fdw ONEMINUS_L
+TWOPLUS_L:
+ .db NFA|INLINE|2, "2+",0
+TWOPLUS:
+ adiw tosl, 2
+ ret
+
+ fdw TWOPLUS_L
+TOBODY_L:
+ .db NFA|INLINE|5, ">body"
+TOBODY:
+ adiw tosl, 4
+ ret
+
+ fdw TOBODY_L
+TWOSTAR_L:
+ .db NFA|INLINE|2, "2*",0
+TWOSTAR:
+ lsl tosl
+ rol tosh
+ ret
+
+ fdw TWOSTAR_L
+TWOSLASH_L:
+ .db NFA|INLINE|2, "2/",0
+TWOSLASH:
+ asr tosh
+ ror tosl
+ ret
+
+ fdw TWOSLASH_L
+PLUSSTORE_L:
+ .db NFA|2,"+!",0
+PLUSSTORE:
+ rcall SWOP
+ rcall OVER
+ rcall FETCH_A
+ rcall PLUS
+ rcall SWOP
+ jmp STORE
+
+ fdw PLUSSTORE_L
+WITHIN_L:
+ .db NFA|6,"within",0
+WITHIN:
+ rcall OVER
+ rcall MINUS
+ rcall TOR
+ rcall MINUS
+ rcall RFROM
+ jmp ULESS
+
+ fdw WITHIN_L
+NOTEQUAL_L:
+ .db NFA|2,"<>",0
+NOTEQUAL:
+ rcall EQUAL
+ jmp ZEROEQUAL
+
+ fdw ZEROLESS_L
+EQUAL_L:
+ .db NFA|1, "="
+EQUAL:
+ rcall MINUS
+ jmp ZEROEQUAL
+
+
+ fdw EQUAL_L
+LESS_L:
+ .db NFA|1,"<"
+LESS:
+ rcall MINUS
+ jmp ZEROLESS
+
+ fdw LESS_L
+GREATER_L:
+ .db NFA|1,">"
+GREATER:
+ rcall SWOP
+ jmp LESS
+
+ fdw GREATER_L
+ULESS_L:
+ .db NFA|2,"u<",0
+ULESS:
+ rcall MINUS ; Carry is valid after MINUS
+ sbc tosl, tosl
+ sbc tosh, tosh
+ ret
+
+ fdw ULESS_L
+UGREATER_L:
+ .db NFA|2, "u>",0
+UGREATER:
+ rcall SWOP
+ jmp ULESS
+
+ fdw UGREATER_L
+STORE_P_L:
+ .db NFA|2,"!p",0
+STORE_P:
+ movw pl, tosl
+ poptos
+ ret
+
+ fdw STORE_P_L
+STORE_P_TO_R_L:
+ .db NFA|COMPILE|4,"!p>r",0
+STORE_P_TO_R:
+ m_pop_zh
+ pop zh
+ pop zl
+ push pl
+ push ph
+ movw pl, tosl
+ poptos
+ mijmp
+
+ fdw STORE_P_TO_R_L
+R_TO_P_L:
+ .db NFA|COMPILE|3,"r>p"
+R_TO_P:
+ m_pop_zh
+ pop zh
+ pop zl
+ pop ph
+ pop pl
+ mijmp
+
+ fdw R_TO_P_L
+PFETCH_L:
+ .db NFA|2,"p@",0
+PFETCH:
+ pushtos
+ movw tosl, pl
+ jmp FETCH
+
+ fdw PFETCH_L
+PSTORE_L:
+ .db NFA|2,"p!",0
+PSTORE:
+ pushtos
+ movw tosl, pl
+ jmp STORE
+
+ fdw PSTORE_L
+PCSTORE_L:
+ .db NFA|3,"pc!"
+PCSTORE:
+ pushtos
+ movw tosl, pl
+ jmp CSTORE
+
+ fdw PCSTORE_L
+PPLUS_L:
+ .db NFA|INLINE|2,"p+",0
+PPLUS:
+ add pl, r_one
+ adc ph, r_zero
+ ret
+
+ fdw PPLUS_L
+PNPLUS_L:
+ .db NFA|3,"p++"
+PNPLUS:
+ add pl, tosl
+ adc ph, tosh
+ poptos
+ ret
+
+ fdw PNPLUS_L
+UEMIT_L:
+ .db NFA|5,"'emit"
+UEMIT_:
+ rcall DOUSER
+ .dw uemit
+
+ fdw UEMIT_L
+UKEY_L:
+ .db NFA|4,"'key",0
+UKEY_:
+ rcall DOUSER
+ .dw ukey
+
+ fdw UKEY_L
+UKEYQ_L:
+ .db NFA|5,"'key?"
+UKEYQ_:
+ rcall DOUSER
+ .dw ukeyq
+
+ .db NFA|3,"?0="
+ZEROSENSE:
+ sbiw tosl, 0
+ poptos
+ ret
+
+ .db NFA|3,"d0="
+DUPZEROSENSE:
+ sbiw tosl, 0
+ ret
+
+ fdw UKEYQ_L
+UMSTAR_L:
+ .db NFA|3,"um*"
+UMSTAR:
+ jmp umstar0
+
+ fdw UMSTAR_L
+UMSLASHMOD_L:
+ .db NFA|6,"um/mod",0
+UMSLASHMOD:
+ jmp umslashmod0
+
+
+ fdw UMSLASHMOD_L
+USLASHMOD_L:
+ .db NFA|5,"u/mod"
+USLASHMOD:
+ rcall FALSE_
+ rcall SWOP
+ jmp umslashmod0
+
+ fdw USLASHMOD_L
+STAR_L:
+ .db NFA|1,"*"
+STAR:
+ rcall UMSTAR
+ jmp DROP
+
+ fdw STAR_L
+USLASH_L:
+ .db NFA|2,"u/",0
+USLASH:
+ rcall USLASHMOD
+ jmp NIP
+
+ fdw USLASH_L
+USSMOD_L:
+ .db NFA|6,"u*/mod",0
+USSMOD:
+ rcall TOR
+ rcall UMSTAR
+ rcall RFROM
+ jmp UMSLASHMOD
+
+
+ fdw USSMOD_L
+SLASH_L:
+ .db NFA|1,"/"
+SLASH:
+ rcall TWODUP
+ rcall XOR_
+ rcall TOR
+ rcall ABS_
+ rcall SWOP
+ rcall ABS_
+ rcall SWOP
+ rcall USLASH
+ rcall RFROM
+ jmp QNEGATE
+
+ fdw SLASH_L
+NIP_L:
+ .db NFA|INLINE|3,"nip"
+NIP:
+ ld t0, y+
+ ld t0, y+
+ ret
+
+ fdw NIP_L
+TUCK_L:
+ .db NFA|4,"tuck",0
+TUCK:
+ rcall SWOP
+ jmp OVER
+
+ fdw TUCK_L
+QNEGATE_L:
+ .db NFA|7,"?negate"
+QNEGATE:
+ rcall ZEROLESS
+ rcall ZEROSENSE
+ breq QNEGATE1
+ rcall NEGATE
+QNEGATE1:
+ ret
+
+ fdw QNEGATE_L
+MAX_L:
+ .db NFA|3,"max"
+MAX: rcall TWODUP
+ rcall LESS
+ rjmp MINMAX
+
+ fdw MAX_L
+MIN_L:
+ .db NFA|3,"min"
+MIN: rcall TWODUP
+ rcall GREATER
+ rjmp MINMAX
+
+ .db NFA|2,"c@",0
+CFETCH_A:
+ jmp CFETCH
+
+ .db NFA|2,"c!",0
+CSTORE_A:
+ jmp CSTORE
+
+ fdw MIN_L
+UPTR_L:
+ .db NFA|2,"up",0
+UPTR: rcall DOCREATE
+ .dw 2 ; upl
+
+ fdw UPTR_L
+HOLD_L:
+ .db NFA|4,"hold",0
+HOLD: rcall TRUE_
+ rcall HP
+ rcall PLUSSTORE
+ rcall HP
+ rcall FETCH_A
+ jmp CSTORE
+
+; <# -- begin numeric conversion
+; PAD HP ! ; (initialize Hold Pointer)
+ fdw HOLD_L
+LESSNUM_L:
+ .db NFA|2,"<#",0
+LESSNUM:
+ rcall PAD
+ rcall HP
+ jmp STORE
+
+; digit n -- c convert to 0..9a..z
+ fdw LESSNUM_L
+TODIGIT_L:
+ .db NFA|5,"digit"
+TODIGIT:
+ cpi tosl, 0xa
+ brlt TODIGIT1
+ adiw tosl, 0x27
+TODIGIT1:
+ adiw tosl, 0x30
+ ret
+
+; # ud1 -- ud2 convert 1 digit of output
+; base @ ud/mod rot >digit hold ;
+ fdw TODIGIT_L
+NUM_L:
+ .db NFA|1,"#"
+NUM:
+ rcall BASE
+ rcall FETCH_A
+ rcall UDSLASHMOD
+ rcall ROT
+ rcall TODIGIT
+ jmp HOLD
+
+; #S ud1 -- ud2 convert remaining digits
+; begin # 2dup or 0= until ;
+ fdw NUM_L
+NUMS_L:
+ .db NFA|2,"#s",0
+NUMS:
+ rcall NUM
+ rcall TWODUP
+ rcall OR_
+ rcall ZEROSENSE
+ brne NUMS
+ ret
+
+; #> ud1 -- c-addr u end conv., get string
+; 2drop hp @ pad over - ;
+ fdw NUMS_L
+NUMGREATER_L:
+ .db NFA|2,"#>", 0
+NUMGREATER:
+ rcall TWODROP
+ rcall HP
+ rcall FETCH_A
+ rcall PAD
+ rcall OVER
+ jmp MINUS
+
+; SIGN n -- add minus sign if n<0
+; 0< IF 2D HOLD THEN ;
+ fdw NUMGREATER_L
+SIGN_L:
+ .db NFA|4,"sign",0
+SIGN:
+ cpi tosh, 0
+ brpl SIGN1
+ rcall DOLIT
+ .dw 0x2D
+ rcall HOLD
+SIGN1:
+ jmp DROP
+
+; U. u -- display u unsigned
+; <# 0 #S #> TYPE SPACE ;
+ fdw SIGN_L
+UDOT_L:
+ .db NFA|2,"u.",0
+UDOT:
+ rcall LESSNUM
+ rcall FALSE_
+ rcall NUMS
+ rcall NUMGREATER
+ rcall TYPE
+ jmp SPACE_
+
+
+; U.R u +n -- display u unsigned in field of n. 1<n<=255
+; 0 swap <# 1- for # next #s #> type space ;
+ fdw UDOT_L
+UDOTR_L:
+ .db NFA|3,"u.r"
+UDOTR:
+ rcall LESSNUM
+ rcall ONEMINUS
+ rcall TOR
+ rcall FALSE_
+ rjmp UDOTR2
+UDOTR1:
+ rcall NUM
+UDOTR2:
+ rcall XNEXT
+ brcc UDOTR1
+ pop t1
+ pop t0
+ rcall NUMS
+ rcall NUMGREATER
+ rcall TYPE
+ jmp SPACE_
+
+; . n -- display n signed
+; <# DUP ABS #S SWAP SIGN #> TYPE SPACE ;
+ fdw UDOTR_L
+DOT_L:
+ .db NFA|1,"."
+DOT: rcall LESSNUM
+ rcall DUP
+ rcall ABS_
+ rcall FALSE_
+ rcall NUMS
+ rcall ROT
+ rcall SIGN
+ rcall NUMGREATER
+ rcall TYPE
+ jmp SPACE_
+
+ FDW DOT_L
+DECIMAL_L:
+ .db NFA|7,"decimal"
+DECIMAL:
+ rcall TEN
+ rcall BASE
+ jmp STORE
+
+; HEX -- set number base to hex
+; #16 BASE ! ;
+ Fdw DECIMAL_l
+HEX_L:
+ .db NFA|3,"hex"
+HEX:
+ rcall DOLIT
+ .dw 16
+ rcall BASE
+ jmp STORE
+
+; BIN -- set number base to binary
+; #2 BASE ! ;
+ Fdw HEX_L
+BIN_L:
+ .db NFA|3,"bin"
+BIN: rcall CELL
+ rcall BASE
+ jmp STORE
+
+; RSAVE -- a-addr Saved return stack pointer
+ fdw BIN_L
+RSAVE_L:
+ .db NFA|5,"rsave"
+RSAVE_: rcall DOUSER
+ .dw ursave
+
+
+; ULINK -- a-addr link to next task
+ fdw RSAVE_L
+ULINK_L:
+ .db NFA|5,"ulink"
+ULINK_: rcall DOUSER
+ .dw ulink
+
+
+; TASK -- a-addr TASK pointer
+ fdw ULINK_L
+TASK_L:
+ .db NFA|4,"task",0
+TASK: rcall DOUSER
+ .dw utask
+
+
+; HP -- a-addr HOLD pointer
+ fdw TASK_L
+HP_L:
+ .db NFA|2,"hp",0
+HP: rcall DOUSER
+ .dw uhp
+
+; PAD -- a-addr User Pad buffer
+ fdw HP_L
+PAD_L:
+ .db NFA|3,"pad"
+PAD:
+ rcall TIB
+ rcall TIBSIZE
+ jmp PLUS
+
+; BASE -- a-addr holds conversion radix
+ fdw PAD_L
+BASE_L:
+ .db NFA|4,"base",0
+BASE:
+ rcall DOUSER
+ .dw ubase
+
+; USER n --
+ fdw BASE_L
+USER_L:
+ .db NFA|4,"user",0
+USER:
+ rcall CREATE
+ rcall CELL
+ rcall NEGATE
+ rcall IALLOT
+ rcall ICOMMA_
+ rcall XDOES
+DOUSER:
+ m_pop_zh
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ add tosl, upl
+ adc tosh, uph
+ ret
+
+; SOURCE -- adr n current input buffer
+; 'SOURCE 2@ ; length is at higher adrs
+ fdw USER_L
+SOURCE_L:
+ .db NFA|6,"source",0
+SOURCE:
+ rcall TICKSOURCE
+ jmp TWOFETCH
+
+
+; /STRING a u n -- a+n u-n trim string
+; swap over - >r + r>
+ fdw SOURCE_L
+SLASHSTRING_L:
+ .db NFA|7,"/string"
+SLASHSTRING:
+ rcall SWOP
+ rcall OVER
+ rcall MINUS
+ rcall TOR
+ rcall PLUS
+ rcall RFROM
+ ret
+
+; \ Skip the rest of the line
+ fdw SLASHSTRING_L
+BSLASH_L:
+ .db NFA|IMMED|1,0x5c
+BSLASH:
+ rcall SOURCE
+ rcall TOIN
+ rcall STORE_A
+ sbr FLAGS1, (1<<noclear) ; dont clear flags in case of \
+ jmp DROP
+
+; PARSE char -- c-addr u
+ fdw BSLASH_L
+PARSE_L:
+ .db NFA|5,"parse"
+PARSE:
+ rcall DUP ; c c
+ rcall SOURCE ; c c a u
+ rcall TOIN ; c c a u a
+ rcall FETCH_A ; c c a u n
+ rcall SLASHSTRING ; c c a u new tib addr/len
+ push tosl
+ push tosh ; c c a u R: u (new tib len
+ rcall ROT ; c a u c
+ rcall SKIP ; c a u
+ rcall OVER ; c a u a
+ rcall TOR ; c a u R: u a (start of word
+ rcall ROT ; a u c
+ rcall SCAN ; a u end of word, tib left
+ rcall DUPZEROSENSE
+ breq PARSE1
+ rcall ONEMINUS
+PARSE1: rcall RFROM ; a u a
+ rcall RFROM ; a u a u
+ rcall ROT ; a a u u
+ rcall MINUS ; a a n ( addition to toin
+ rcall TOIN
+ rcall PLUSSTORE ; aend astart
+ rcall TUCK ; astart aend astart
+ jmp MINUS ; astart wlen
+
+
+; WORD char -- c-addr word delimited by char and/or TAB
+ fdw PARSE_L
+WORD_L:
+ .db NFA|4,"word",0
+WORD:
+ rcall PARSE ; c-addr wlen
+ rcall SWOP
+ rcall ONEMINUS
+ rcall TUCK
+ jmp CSTORE ; Write the length into the TIB !
+
+; CMOVE src dst u -- copy u bytes from src to dst
+; cmove swap !p for c@+ pc! p+ next drop ;
+ fdw WORD_L
+CMOVE_L:
+ .db NFA|5,"cmove"
+CMOVE:
+ rcall SWOP
+ rcall STORE_P_TO_R
+ rcall TOR
+ rjmp CMOVE2
+CMOVE1:
+ rcall CFETCHPP
+ rcall PCSTORE
+ rcall PPLUS
+CMOVE2:
+ rcall XNEXT
+ brcc CMOVE1
+ pop t1
+ pop t0
+ rcall R_TO_P
+ jmp DROP
+
+
+; place src n dst -- place as counted str
+ fdw CMOVE_L
+PLACE_L:
+ .db NFA|5,"place"
+PLACE:
+ rcall TWODUP
+ rcall CSTORE_A
+ rcall CHARPLUS
+ rcall SWOP
+ jmp CMOVE
+
+; : c@+ ( addr -- addr+1 n ) dup 1+ swap c@ ;
+ fdw PLACE_L
+CFETCHPP_L:
+ .db NFA|3,"c@+"
+CFETCHPP:
+ rcall DUP
+ rcall ONEPLUS
+ rcall SWOP
+ jmp CFETCH
+
+; : @+ ( addr -- addr+2 n ) dup 2+ swap @ ;
+ fdw CFETCHPP_L
+FETCHPP_L:
+ .db NFA|2,"@+",0
+FETCHPP:
+ rcall DUP
+ rcall TWOPLUS
+ rcall SWOP
+ jmp FETCH
+
+ .db NFA|1,"!"
+STORE_A:
+ jmp STORE
+
+; N>C nfa -- cfa name adr -> code field
+ fdw FETCHPP_L
+NTOC_L:
+ .db NFA|3,"n>c"
+NFATOCFA:
+ rcall CFETCHPP
+ andi tosl, 0x0f
+ rcall PLUS
+ jmp ALIGNED
+
+; C>N cfa -- nfa code field addr -> name field addr
+ fdw NTOC_L
+CTON_L:
+ .db NFA|3,"c>n"
+CFATONFA:
+ rcall TWOMINUS
+ rcall DUP
+ rcall CFETCH_A
+ call TO_A
+ sbrs al, 7
+ breq CFATONFA
+ ret
+
+; findi c-addr nfa -- c-addr 0 if not found
+; xt 1 if immediate
+; xt -1 if "normal"
+ fdw CTON_L
+BRACFIND_L:
+ .db NFA|3,"(f)"
+findi:
+findi1:
+FIND_1:
+ rcall TWODUP
+ rcall NEQUAL
+ rcall DUPZEROSENSE
+ breq findi2
+ rcall DROP
+ rcall TWOMINUS ;;; NFATOLFA
+ rcall FETCH_A
+ rcall DUP
+findi2:
+ rcall ZEROSENSE
+ brne findi1
+ rcall DUPZEROSENSE
+ breq findi3
+ rcall NIP
+ rcall DUP
+ rcall NFATOCFA
+ rcall SWOP
+ rcall IMMEDQ
+ rcall ZEROEQUAL
+ rcall ONE
+ rcall OR_
+findi3:
+ ret
+
+; IMMED? nfa -- f fetch immediate flag
+ fdw BRACFIND_L
+IMMEDQ_L:
+ .db NFA|6,"immed?",0
+IMMEDQ:
+ rcall CFETCH_A
+ mov wflags, tosl ; COMPILE and INLINE flags for the compiler
+ andi tosl, IMMED
+ ret
+
+; FIND c-addr -- c-addr 0 if not found
+; xt 1 if immediate
+; xt -1 if "normal"
+ fdw IMMEDQ_L
+FIND_L:
+ .db NFA|4,"find",0
+FIND:
+ rcall DOLIT
+ fdw kernellink
+ rcall findi
+ rcall DUPZEROSENSE
+ brne FIND1
+ rcall DROP
+ rcall LATEST_
+ rcall FETCH_A
+ rcall findi
+FIND1:
+ ret
+
+; DIGIT? c -- n -1 if c is a valid digit
+ fdw FIND_L
+DIGITQ_L:
+ .db NFA|6,"digit?",0
+DIGITQ:
+ ; 1 = 0x31 a = 0x61
+ cpi tosl, 0x40
+ brlt DIGITQ1
+ sbiw tosl, 0x27
+DIGITQ1:
+ sbiw tosl, 0x30 ; 1
+ brpl DIGITQ2
+ rjmp FALSE_
+DIGITQ2:
+ rcall DUP ; 1 1
+ rcall BASE ; 1 1 base
+ rcall FETCH_A ; 1 1 10
+ jmp LESS ; 1 ffff
+
+
+; SIGN? adr n -- adr' n' f get optional sign
+; + leaves $0000 flag
+; - leaves $0002 flag
+ fdw DIGITQ_L
+SIGNQ_L:
+ .db NFA|5,"sign?"
+SIGNQ:
+ rcall OVER
+ rcall CFETCH_A
+ mov t0, tosl
+ rcall DROP
+ cpi t0, '-'
+ breq SIGNQMINUS
+ cpi t0, '+'
+ breq SIGNQPLUS
+ rjmp SIGNQEND
+SIGNQMINUS:
+ rcall SLASHONE
+ rjmp TRUE_
+SIGNQPLUS:
+ rcall SLASHONE
+SIGNQEND:
+ jmp FALSE_
+SLASHONE:
+ rcall ONE
+ jmp SLASHSTRING
+
+; UD* ud u -- ud
+ fdw SIGNQ_L
+UDSTAR_L:
+ .db NFA|3,"ud*"
+UDSTAR:
+ push tosl
+ push tosh
+ rcall UMSTAR
+ rcall DROP
+ rcall SWOP
+ rcall RFROM
+ rcall UMSTAR
+ rcall ROT
+ jmp PLUS
+
+; UD/MOD ud u --u(rem) ud(quot)
+ fdw UDSTAR_L
+UDSLASHMOD_L:
+ .db NFA|6,"ud/mod",0
+UDSLASHMOD:
+ rcall TOR ; ud.l ud.h
+ rcall FALSE_ ; ud.l ud.h 0
+ rcall RFETCH ; ud.l ud.h 0 u
+ rcall UMSLASHMOD ; ud.l r.h q.h
+ rcall ROT ; r.h q.h ud.l
+ rcall ROT ; q.h ud.l r.h
+ rcall RFROM ; q.h ud.l r.h u
+ rcall UMSLASHMOD ; q.h r.l q.l
+ jmp ROT ; r.l q.l q.h
+
+; >NUMBER 0 0 adr u -- ud.l ud.h adr' u'
+; convert string to number
+ fdw UDSLASHMOD_L
+TONUMBER_L:
+ .db NFA|7,">number"
+TONUMBER:
+ ldi al, 1
+TONUM1:
+ rcall DUPZEROSENSE ; ud.l ud.h adr u
+ breq TONUM3
+ rcall TOR
+ push tosl ; dup >r
+ push tosh ; ud.l ud.h adr
+ rcall CFETCH_A
+ cpi tosl, '.'
+ breq TONUM_SKIP
+ rcall DIGITQ ; ud.l ud.h digit flag
+ rcall ZEROSENSE
+ brne TONUM2
+ rcall DROP
+ rcall RFROM
+ rcall RFROM
+ rjmp TONUM3
+TONUM2:
+ rcall TOR ; ud.l ud.h digit
+ rcall BASE
+ rcall FETCH_A
+ rcall UDSTAR
+ rcall RFROM
+ rcall MPLUS
+ ldi al, 0
+ rjmp TONUM_CONT
+TONUM_SKIP:
+ rcall DROP
+TONUM_CONT:
+ rcall RFROM
+ rcall RFROM
+ rcall SLASHONE
+ rjmp TONUM1
+TONUM3:
+ add tosl, al
+ ret
+
+; NUMBER? c-addr -- n 1
+; -- dl dh 2
+; -- c-addr 0 if convert error
+ fdw TONUMBER_L
+NUMBERQ_L:
+ .db NFA|7,"number?"
+NUMBERQ:
+ rcall DUP ; a a
+ rcall FALSE_ ; a a 0 0
+ rcall FALSE_ ; a a 0 0
+ rcall ROT ; a 0 0 a
+ rcall CFETCHPP ; a 0 0 a' u
+ rcall SIGNQ ; a 0 0 a' u f
+ rcall TOR ; a 0 0 a' u
+
+ rcall BASE
+ rcall FETCH_A
+ rcall TOR ; a 0 0 a' u
+
+ rcall OVER
+ rcall CFETCH_A
+
+ sbiw tosl, '#'
+ cpi tosl, 3
+ brsh BASEQ1
+
+ rcall CELLS
+ rcall DOLIT
+ fdw BASEQV
+ rcall PLUS
+ rcall FEXECUTE
+
+ rcall SLASHONE
+ rjmp BASEQ2
+BASEQ1:
+ rcall DROP
+BASEQ2: ; a 0 0 a' u
+ rcall TONUMBER ; a ud.l ud.h a' u
+ rcall RFROM ; a ud.l ud.h a' u oldbase
+ rcall BASE ; a ud.l ud.h a' u oldbase addr
+ rcall STORE_A ; a ud.l ud.h a' u
+ rcall ZEROSENSE ; a ud.l ud.h a' u
+ breq QNUMD
+QNUM_ERR: ; Not a number
+ rcall RFROM ; a ud.l ud.h a' u sign
+ rcall TWODROP
+ rcall TWODROP
+ rcall FALSE_ ; a 0 Not a number
+ rjmp QNUM3
+QNUMD: ; Single or Double number
+ ; a ud.l ud.h a'
+ sbiw tosl, 1
+ rcall CFETCH_A ; a ud.l ud.h c
+ call TO_A
+ rcall RFROM ; a a' u ud.l ud.d sign
+ rcall ZEROSENSE
+ breq QNUMD1
+ rcall DNEGATE
+QNUMD1:
+ cpi al, '.' ; a d.l d.h
+ brne QNUM1
+ rcall ROT ; d.l d.h a
+ ldi tosl, 2
+ ldi tosh, 0 ; d.l d.h 2 Double number
+ rjmp QNUM3
+QNUM1: ; single precision dumber
+ ; a d.l d.h
+ rcall DROP ; a n
+ rcall NIP ; n
+ rcall ONE ; n 1 Single number
+QNUM3:
+ ret
+
+
+ .db NFA|4,"swap",0
+SWOP_A:
+ jmp SWOP
+
+; TI# -- n size of TIB
+; : ti# task @ 8 + @ ;
+ fdw NUMBERQ_L
+TIBSIZE_L:
+ .db NFA|3,"ti#"
+TIBSIZE:
+ rcall TASK
+ rcall FETCH_A
+ adiw tosl, 8
+ jmp FETCH
+
+; TIB -- a-addr Terminal Input Buffer
+ fdw TIBSIZE_L
+TIB_L:
+ .db NFA|3,"tib"
+TIB:
+ rcall TIU
+ jmp FETCH
+
+; TIU -- a-addr Terminal Input Buffer user variable
+ fdw TIB_L
+TIU_L:
+ .db NFA|3,"tiu"
+TIU:
+ rcall DOUSER
+ .dw utib ; pointer to Terminal input buffer
+
+; >IN -- a-addr holds offset into TIB
+; In RAM
+ fdw TIU_L
+TOIN_L:
+ .db NFA|3,">in"
+TOIN:
+ rcall DOUSER
+ .dw utoin
+
+; 'SOURCE -- a-addr two cells: len, adrs
+; In RAM ?
+ fdw TOIN_L
+TICKSOURCE_L:
+ .db NFA|7,"'source"
+TICKSOURCE:
+ rcall DOUSER
+ .dw usource ; two cells !!!!!!
+
+WORDQ:
+ rcall DUP
+ m_pop_t0
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ ror zh
+ ror zl
+ rcall EQUAL
+ rcall ZEROSENSE
+ mijmp
+
+; INTERPRET c-addr u -- interpret given buffer
+ fdw TICKSOURCE_L
+INTERPRET_L:
+ .db NFA|9,"interpret"
+INTERPRET:
+ rcall TICKSOURCE
+ rcall TWOSTORE
+ rcall FALSE_
+ rcall TOIN
+ rcall STORE_A
+IPARSEWORD:
+ rcall INIT_012
+ rcall BL
+ rcall WORD
+
+ rcall DUP
+ rcall CFETCH_A
+ rcall ZEROSENSE
+ brne IPARSEWORD1
+ rjmp INOWORD
+IPARSEWORD1:
+ rcall FIND ; sets also wflags
+ rcall DUPZEROSENSE ; 0 = not found, -1 = normal, 1 = immediate
+ brne IPARSEWORD2 ; NUMBER?
+ rjmp INUMBER
+IPARSEWORD2:
+ rcall ONEPLUS ; 0 = normal 2 = immediate
+ rcall STATE_
+ rcall ZEROEQUAL
+ rcall OR_
+ rcall ZEROSENSE
+ breq ICOMPILE_1 ; Compile a word
+
+ ; Execute a word
+ ; immediate&compiling or interpreting
+ sbrs wflags, 4 ; Compile only check
+ rjmp IEXECUTE ; Not a compile only word
+ rcall STATE_ ; Compile only word check
+ rcall XSQUOTE
+ .db 12,"COMPILE ONLY",0
+ rcall QABORT
+IEXECUTE:
+ cbr FLAGS1, (1<<noclear)
+ rcall EXECUTE
+ sbrc FLAGS1, noclear ; set by \ and by (
+ rjmp IPARSEWORD
+ cbr FLAGS1, (1<<izeroeq) ; Clear 0= encountered in compilation
+ cbr FLAGS1, (1<<idup) ; Clear DUP encountered in compilation
+ rjmp ICLRFLIT
+ICOMPILE_1:
+ cbr FLAGS1, (1<<izeroeq) ; Clear 0= encountered in compilation
+ rcall WORDQ
+ fdw ZEROEQUAL ; Check for 0=, modifies IF and UNTIL to use bnz
+ breq ICOMPILE_2
+ sbr FLAGS1, (1<<izeroeq) ; Mark 0= encountered in compilation
+ rjmp ICOMMAXT
+ICOMPILE_2:
+ sbrs FLAGS1, fLIT
+ rjmp ICOMPILE_6
+ rcall WORDQ
+ fdw AND_
+ breq ICOMPILE_3
+ rcall ANDIC_
+ rjmp ICLRFLIT
+ICOMPILE_3:
+ rcall WORDQ
+ fdw OR_
+ breq ICOMPILE_4
+ rcall ORIC_
+ rjmp ICLRFLIT
+ICOMPILE_4:
+ rcall WORDQ
+ fdw PLUS
+ breq ICOMPILE_5
+ rcall PLUSC_
+ rjmp ICLRFLIT
+ICOMPILE_5:
+ rcall WORDQ
+ fdw MINUS
+ breq ICOMPILE_6
+ rcall MINUSC_
+ rjmp ICLRFLIT
+ICOMPILE_6:
+ cbr FLAGS1, (1<<idup) ; Clear DUP encountered in compilation
+ rcall WORDQ
+ fdw DUP ; Check for DUP, modies IF and UNTIl to use DUPZEROSENSE
+ breq ICOMPILE
+ sbr FLAGS1, (1<<idup) ; Mark DUP encountered during compilation
+ICOMPILE:
+ sbrs wflags, 5 ; Inline check
+ rjmp ICOMMAXT
+ call INLINE0
+ rjmp ICLRFLIT
+ICOMMAXT:
+ rcall COMMAXT_A
+ cbr FLAGS1, (1<<fTAILC) ; Allow tailjmp optimisation
+ sbrc wflags, 4 ; Compile only ?
+ sbr FLAGS1, (1<<fTAILC) ; Prevent tailjmp optimisation
+ICLRFLIT:
+ cbr FLAGS1, (1<<fLIT)
+ rjmp IPARSEWORD
+INUMBER:
+ cbr FLAGS1, (1<<izeroeq) | (1<<idup) | (1<<fLIT)
+ rcall DROP
+ rcall NUMBERQ
+ rcall DUPZEROSENSE
+ breq IUNKNOWN
+ rcall STATE_
+ rcall ZEROSENSE
+ breq INUMBER1
+ mov t0, tosl
+ poptos
+ sbrs t0, 1
+ rjmp ISINGLE
+IDOUBLE:
+ rcall SWOP_A
+ call LITERAL
+ISINGLE:
+ call LITERAL
+ rjmp IPARSEWORD
+
+INUMBER1:
+ rcall DROP
+ rjmp ICLRFLIT
+
+IUNKNOWN:
+ rcall DROP
+ rcall DP_TO_RAM
+ rcall CFETCHPP
+ rcall TYPE
+ rcall FALSE_
+ rcall QABORTQ ; Never returns & resets the stacks
+INOWORD:
+ rcall INIT_012
+ jmp DROP
+
+ .db NFA|1,"@"
+FETCH_A:
+ jmp FETCH
+
+;;; bitmask --
+ fdw INTERPRET_L
+SHB_L:
+ .db NFA|3,"shb" ; Set header bit
+SHB:
+ rcall LATEST_
+ rcall FETCH_A
+ rcall DUP
+ rcall CFETCH_A
+ rcall ROT
+ rcall OR_
+ rcall SWOP_A
+ jmp CSTORE
+
+ fdw SHB_L
+IMMEDIATE_L:
+ .db NFA|9,"immediate" ;
+IMMEDIATE:
+ rcall DOLIT
+ .dw IMMED
+ jmp SHB
+
+;***************************************************************
+ fdw IMMEDIATE_L
+INLINED_L:
+ .db NFA|7,"inlined" ;
+INLINED:
+ rcall DOLIT
+ .dw INLINE
+ jmp SHB
+
+;; .st ( -- ) output a string with current data section and current base info
+;;; : .st base @ dup decimal <# [char] , hold #s [char] < hold #> type
+;;; <# [char] > hold cse @ #s #> type base ! ;
+ fdw INLINED_L
+DOTSTATUS_L:
+ .db NFA|3,".st"
+DOTSTATUS:
+ rcall DOLIT
+ .dw '<'
+ rcall EMIT
+ call DOTBASE
+ rcall EMIT
+ rcall DOLIT
+ .dw ','
+ rcall EMIT
+ call MEMQ
+ rcall TYPE
+ rcall DOLIT
+ .dw '>'
+ rcall EMIT
+ jmp DOTS
+
+ .db NFA|2,">r",0
+TOR_A: jmp TOR
+
+
+;;; TEN ( -- n ) Leave decimal 10 on the stack
+; .db NFA|1,"a"
+TEN:
+ rcall DOCREATE
+ .dw 10
+
+; dp> ( -- ) Copy ini, dps and latest from eeprom to ram
+; .dw link
+; link set $
+ .db NFA|3,"dp>"
+DP_TO_RAM:
+ rcall DOLIT
+ .dw dp_start
+ rcall INI
+ rcall TEN
+ jmp CMOVE
+
+; >dp ( -- ) Copy only changed turnkey, dp's and latest from ram to eeprom
+; .dw link
+; link set $
+ .db NFA|3,">dp"
+DP_TO_EEPROM:
+ rcall DOLIT
+ .dw dp_start
+ rcall STORE_P_TO_R
+ rcall INI
+ rcall DOLIT
+ .dw 4
+ rcall TOR
+DP_TO_EEPROM_0:
+ rcall FETCHPP
+ rcall DUP
+ rcall PFETCH
+ rcall NOTEQUAL
+ rcall ZEROSENSE
+ breq DP_TO_EEPROM_1
+.if DEBUG_FLASH == 1
+ rcall DOLIT
+ .dw 'E'
+ call EMIT
+.endif
+ rcall PSTORE
+ rjmp DP_TO_EEPROM_2
+DP_TO_EEPROM_1:
+ rcall DROP
+DP_TO_EEPROM_2:
+ rcall PTWOPLUS
+DP_TO_EEPROM_3:
+ rcall XNEXT
+ brcc DP_TO_EEPROM_0
+ pop t1
+ pop t0
+ rcall R_TO_P
+ jmp DROP
+
+ fdw DOTSTATUS_L
+FALSE_L:
+ .db NFA|5,"false"
+FALSE_: ; TOS is 0000 (FALSE)
+ pushtos
+ clr tosl
+ clr tosh
+ ret
+
+ fdw FALSE_L
+TRUE_L:
+ .db NFA|4,"true",0
+TRUE_: ; TOS is ffff (TRUE)
+ pushtos
+ ser tosl
+ ser tosh
+ ret
+
+; QUIT -- R: i*x -- interpret from kbd
+ fdw TRUE_L
+QUIT_L:
+ .db NFA|4,"quit",0
+QUIT:
+ rcall RPEMPTY
+ rcall LEFTBRACKET
+ rcall FRAM
+QUIT0:
+ ;; Copy INI and DP's from eeprom to ram
+ rcall DP_TO_RAM
+QUIT1:
+ rcall check_sp
+ rcall CR
+ rcall TIB
+ rcall DUP
+ rcall TIBSIZE
+ sbiw tosl, 10 ; Reserve 10 bytes for hold buffer
+ rcall ACCEPT
+ rcall SPACE_
+ rcall INTERPRET
+ rcall STATE_
+ rcall ZEROSENSE
+ brne QUIT1
+ rcall IFLUSH
+ rcall DP_TO_EEPROM
+
+ rcall XSQUOTE
+ .db 3," ok"
+ rcall TYPE
+ rcall PROMPT_
+ jmp QUIT0
+
+
+ fdw QUIT_L
+PROMPT_L:
+ .db NFA|6,"prompt",0
+PROMPT_:
+ call DEFER_DOES
+ .dw prompt
+
+; ABORT i*x -- R: j*x -- clear stk & QUIT
+ fdw PROMPT_L
+ABORT_L:
+ .db NFA|5,"abort"
+ABORT:
+ rcall S0
+ rcall FETCH_A
+ rcall SPSTORE
+ jmp QUIT ; QUIT never rets
+
+; ?ABORT f -- abort & print ?
+ fdw ABORT_L
+QABORTQ_L:
+ .db NFA|7,"?abort?"
+QABORTQ:
+ rcall XSQUOTE
+ .db 1,"?"
+ jmp QABORT
+
+
+; ?ABORT f c-addr u -- abort & print msg if flag is false
+ fdw QABORTQ_L
+QABORT_L:
+ .db NFA|6,"?abort",0
+QABORT:
+ rcall ROT
+ rcall ZEROSENSE
+ brne QABO1
+QABORT1:
+ rcall SPACE_
+ rcall TYPE
+ rcall ABORT ; ABORT never returns
+QABO1: jmp TWODROP
+
+; ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0
+; i*x x1 -- R: j*x -- x1<>0
+ fdw QABORT_L
+ABORTQUOTE_L:
+ .db NFA|IMMED|COMPILE|6,"abort",0x22,0
+ABORTQUOTE:
+ rcall SQUOTE
+ rcall DOCOMMAXT
+ fdw QABORT
+ ret
+
+;***************************************************
+; LIT -- x fetch inline 16 bit literal to the stack
+ fdw ABORTQUOTE_L
+DOLIT_L:
+ .db NFA|3, "lit"
+DOLIT:
+ m_pop_zh
+ pop zh
+ pop zl
+ rcall FETCHLIT
+ ror zh
+ ror zl
+ mijmp ; (z)
+
+; DUP must not be reachable from user code with rcall
+ fdw RFETCH_L
+DUP_L:
+ .db NFA|INLINE|3, "dup"
+DUP:
+ pushtos
+ ret
+
+ fdw NOTEQUAL_L
+ZEROEQUAL_L:
+ .db NFA|2, "0=",0
+ZEROEQUAL:
+ sbiw tosl, 1
+ sbc tosl, tosl
+ sbc tosh, tosh
+ ret
+
+ fdw ZEROEQUAL_L
+ZEROLESS_L:
+ .db NFA|2, "0<",0
+ZEROLESS:
+ lsl tosh
+ sbc tosl, tosl
+ sbc tosh, tosh
+ ret
+
+
+; ' -- xt find word in dictionary
+ fdw DOLIT_L
+TICK_L:
+ .db NFA|1,0x27 ; 27h = '
+TICK:
+ rcall BL
+ rcall WORD
+ rcall FIND
+ jmp QABORTQ
+
+; CHAR -- char parse ASCII character
+ fdw TICK_L
+CHAR_L:
+ .db NFA|4,"char",0
+CHAR:
+ rcall BL
+ rcall PARSE
+ rcall DROP
+ jmp CFETCH
+
+; ( -- skip input until )
+ fdw CHAR_L
+PAREN_L:
+ .db NFA|IMMED|1,"("
+PAREN:
+ rcall DOLIT
+ .dw ')'
+ rcall PARSE
+ sbr FLAGS1, (1<<noclear) ; dont clear flags in case of (
+ jmp TWODROP
+
+; IHERE -- a-addr ret Code dictionary ptr
+; IDP @ ;
+ fdw PAREN_L
+IHERE_L:
+ .db NFA|5,"ihere"
+IHERE:
+ rcall IDP
+ rjmp FETCH_A
+
+; [CHAR] -- compile character DOLITeral
+ fdw IHERE_L
+BRACCHAR_L:
+ .db NFA|IMMED|COMPILE|6,"[char]",0
+BRACCHAR:
+ rcall CHAR
+ jmp LITERAL
+
+; COMPILE, xt -- append codefield
+ .db NFA|3,"cf,"
+COMMAXT_A:
+ jmp COMMAXT
+
+; CR -- output newline
+ fdw BRACCHAR_L
+CR_L:
+ .db NFA|2,"cr",0
+CR:
+ rcall DOLIT
+ .dw 0x0d ; CR \r
+ rcall EMIT
+ rcall DOLIT
+ .dw 0x0a ; LF \n
+EMIT_A:
+ jmp EMIT
+
+; CREATE -- create an empty definition
+; Create a definition header and append
+; doCREATE and the current data space dictionary pointer
+; in FLASH.
+; Examples :
+; : table create 10 cells allot does> swap cells + ;
+; ram table table_a flash table table_b eeprom table table_c
+; ram variable qqq
+; eeprom variable www ram
+; flash variable rrr ram
+; eeprom create calibrationtable 30 allot ram
+;
+ fdw CR_L
+CREATE_L:
+ .db NFA|6,"create",0
+CREATE:
+ rcall BL
+ rcall WORD ; Parse a word
+
+ rcall DUP ; Remember parsed word at rhere
+ rcall FIND
+ rcall NIP
+ rcall ZEROEQUAL
+ rcall XSQUOTE
+ .db 15,"ALREADY DEFINED"
+ rcall QABORT ; ABORT if word has already been defined
+ rcall DUP ; Check the word length
+ rcall CFETCH_A
+ rcall ONE
+ rcall DOLIT
+ .dw 16
+ rcall WITHIN
+ rcall QABORTQ ; Abort if there is no name for create
+
+ rcall IHERE
+ rcall ALIGNED
+ rcall IDP ; Align the flash DP.
+ rcall STORE_A
+
+ rcall LATEST_
+ rcall FETCH_A
+ rcall ICOMMA_ ; Link field
+ rcall CFETCHPP ; str len
+ rcall IHERE
+ rcall DUP
+ rcall LATEST_ ; new 'latest' link
+ rcall STORE_A ; str len ihere
+ rcall PLACE ;
+ rcall IHERE ; ihere
+ rcall CFETCH_A
+ rcall DOLIT
+ .dw NFA
+ rcall SHB
+ rcall ONEPLUS
+ rcall ALIGNED
+ rcall IALLOT ; The header has now been created
+ rcall DOLIT
+ fdw DOCREATE ; compiles the runtime routine to fetch the next dictionary cell to the parameter stack
+ rcall STORECFF1 ; Append an exeution token, CALL !
+ rcall ALIGN
+ rcall HERE ; compiles the current dataspace dp into the dictionary
+ rcall CSE_
+ rcall ZEROSENSE
+ brne CREATE2
+ rcall TWOPLUS
+CREATE2:
+ jmp ICOMMA ; dp now points to a free cell
+
+;***************************************************************
+; POSTPONE
+ fdw CREATE_L
+POSTPONE_L:
+ .db NFA|IMMED|COMPILE|8,"postpone",0
+POSTPONE:
+ rcall BL
+ rcall WORD
+ rcall FIND
+ rcall DUP
+ rcall QABORTQ
+ rcall ZEROLESS
+ rcall ZEROSENSE
+ breq POSTPONE1
+ rcall DOCOMMAXT
+ fdw DOCOMMAXT
+ rjmp ICOMMA_
+POSTPONE1:
+ jmp COMMAXT
+
+
+IDP_L:
+ .db NFA|3,"idp"
+IDP:
+ rcall DOCREATE
+ .dw dpFLASH
+
+;***************************************************************
+; (DOES>) -- run-time action of DOES>
+; .dw link
+;link set $
+ .db NFA|7,"(does>)"
+XDOES:
+ m_pop_zh
+ rcall RFROM
+ rcall LATEST_
+ rcall FETCH_A
+ rcall NFATOCFA
+ rcall IDP
+ rcall FETCH_A
+ rcall TOR_A
+ rcall IDP
+ rcall STORE_A
+ lsl tosl
+ rol tosh
+ rcall STORECFF1 ; Always stores a 4 byte call
+ rcall RFROM
+ rcall IDP
+ jmp STORE
+
+
+; DOES> -- change action of latest def'n
+ fdw POSTPONE_L
+DOES_L:
+ .db NFA|IMMED|COMPILE|5,"does>"
+DOES: rcall DOCOMMAXT
+ fdw XDOES
+ rcall DOCOMMAXT
+ fdw DODOES
+ ret
+
+
+;*****************************************************************
+; [ -- enter interpretive state
+ fdw DOES_L
+LEFTBRACKET_L:
+ .db NFA|IMMED|1,"["
+LEFTBRACKET:
+ sts state, r_zero
+ ret
+
+
+; ] -- enter compiling state
+ fdw LEFTBRACKET_L
+RIGHTBRACKET_L:
+ .db NFA|1,"]"
+RIGHTBRACKET:
+ sts state, r_one
+ ret
+
+; : -- begin a colon definition
+ fdw RIGHTBRACKET_L
+COLON_L:
+ .db NFA|1,":"
+COLON:
+ rcall CREATE
+ rcall RIGHTBRACKET
+ jmp STORCOLON
+
+; :noname -- a define headerless forth code
+ fdw COLON_L
+NONAME_L:
+ .db NFA|7,":noname"
+NONAME:
+ rcall IHERE
+ jmp RIGHTBRACKET
+
+; ; -- end a colon definition
+ fdw NONAME_L
+SEMICOLON_L:
+ .db NFA|IMMED|COMPILE|1,";"
+SEMICOLON:
+ rcall LEFTBRACKET
+ sbrc FLAGS1, fTAILC
+ rjmp ADD_RETURN_1
+ rcall IHERE
+ rcall MINUS_FETCH
+ movw t0, tosl
+ andi t1, 0xf0
+ subi t1, 0xd0
+ breq RCALL_TO_JMP
+ poptos
+ rcall MINUS_FETCH
+.ifdef EIND
+ subi tosl, 0x0f
+.else
+ subi tosl, 0x0e
+.endif
+ sbci tosh, 0x94
+ brne ADD_RETURN
+CALL_TO_JMP:
+.ifdef EIND
+ ldi tosl, 0x0d
+.else
+ ldi tosl, 0x0c
+.endif
+ ldi tosh, 0x94
+ rcall SWOP
+ jmp STORE
+RCALL_TO_JMP:
+ rcall NIP
+ andi tosh, 0x0f
+ sbrc tosh, 3
+ ori tosh, 0xf0
+ rcall TWOSTAR
+ rcall IHERE
+ rcall PLUS
+ rcall DOLIT
+ .dw -2
+ rcall IALLOT
+ rcall DOLIT
+.ifdef EIND
+ .dw 0x940d
+.else
+ .dw 0x940c ; jmp:0x940c
+.endif
+ rcall ICOMMA__
+ sub_pflash_tos
+ rampv_to_c
+ ror tosh
+ ror tosl
+ rjmp ICOMMA__
+ADD_RETURN:
+ rcall TWODROP
+ADD_RETURN_1:
+ rcall DOLIT ; Compile a ret
+ .dw 0x9508
+ICOMMA__:
+ jmp ICOMMA
+
+
+
+ fdw SEMICOLON_L
+MINUS_FETCH_L:
+ .db NFA|2,"-@",0
+MINUS_FETCH:
+ rcall TWOMINUS
+ rcall DUP
+ jmp FETCH
+
+; ['] -- find word & compile as DOLITeral
+ fdw MINUS_FETCH_L
+BRACTICK_L:
+ .db NFA|IMMED|COMPILE|3,"[']"
+BRACTICK:
+ rcall TICK ; get xt of 'xxx'
+ jmp LITERAL
+
+; 2- n -- n-2
+ fdw BRACTICK_L
+TWOMINUS_L:
+ .db NFA|INLINE|2,"2-",0
+TWOMINUS:
+ sbiw tosl, 2
+ ret
+
+
+; BL -- char an ASCII space
+ fdw TWOMINUS_L
+BL_l:
+ .db NFA|2,"bl",0
+BL:
+ call DOCREATE
+ .dw ' '
+
+; STATE -- flag holds compiler state
+ fdw BL_L
+STATE_L:
+ .db NFA|5,"state"
+STATE_:
+ pushtos
+ lds tosl, state
+ lds tosh, state
+ ret
+
+; LATEST -- a-addr
+ fdw STATE_L
+LATEST_L:
+ .db NFA|6,"latest",0
+LATEST_:
+ call DOCREATE
+ .dw dpLATEST
+
+; S0 -- a-addr start of parameter stack
+ fdw LATEST_L
+S0_L:
+ .db NFA|2,"s0",0
+S0:
+ rcall DOUSER
+ .dw us0
+
+; R0 -- a-addr start of parameter stack
+ fdw S0_L
+R0_L:
+ .db NFA|2,"r0",0
+R0_:
+ rcall DOUSER
+ .dw ur0
+
+; ini -- a-addr ini variable contains the user-start xt
+; In RAM
+; .dw link
+;link set $
+ .db NFA|3,"ini"
+INI:
+ call DOCREATE
+ .dw dpSTART
+
+; ticks -- u system ticks (0-ffff) in milliseconds
+ fdw R0_L
+TICKS_L:
+ .db NFA|5,"ticks"
+TICKS:
+ pushtos
+ in_ t0, SREG
+ cli
+ mov tosl, ms_count
+ mov tosh, ms_count1
+ out_ SREG, t0
+ ret
+
+
+; ms +n -- Pause for n millisconds
+; : ms ( +n -- )
+; ticks -
+; begin
+; pause dup ticks - 0<
+; until drop ;
+;
+ fdw TICKS_L
+MS_L:
+ .db NFA|2,"ms",0
+MS:
+ rcall TICKS
+ rcall PLUS
+MS1:
+ rcall PAUSE
+ rcall DUP
+ rcall TICKS
+ rcall MINUS
+ rcall ZEROLESS
+ rcall ZEROSENSE
+ breq MS1
+ jmp DROP
+
+; .id ( nfa -- )
+ fdw MS_L
+DOTID_L:
+ .db NFA|3,".id"
+DOTID:
+ rcall CFETCHPP
+ andi tosl, 0x0f
+ rcall TOR
+ rjmp DOTID3
+DOTID1:
+ rcall CFETCHPP
+ rcall TO_PRINTABLE
+ rcall EMIT_A
+DOTID3:
+ rcall XNEXT
+ brcc DOTID1
+ pop t1
+ pop t0
+ jmp DROP
+
+ ; >pr c -- c Filter a character to printable 7-bit ASCII
+ fdw DOTID_L
+TO_PRINTABLE_L:
+ .db NFA|3,">pr"
+TO_PRINTABLE:
+ clr tosh
+ cpi tosl, 0
+ brmi TO_PRINTABLE1
+ cpi tosl, 0x20
+ brpl TO_PRINTABLE2
+TO_PRINTABLE1:
+ ldi tosl, '.'
+TO_PRINTABLE2:
+ ret
+
+;;;;;;;;;;;;;;
+LIKEQ:
+ rcall CFETCHPP
+ rcall DOLIT
+ .dw 0x0f
+ rcall AND_
+ rcall SWOP
+ rcall STORE_P
+ rcall SWOP
+ rcall CFETCHPP
+ rcall ROT
+ rcall OVER
+ rcall MINUS
+ rcall ONEPLUS
+ rcall FALSE_
+ rcall MAX
+ rcall TOR
+ rjmp LIKEQ3
+LIKEQ1:
+ rcall TWODUP
+ rcall FETCH_P
+ rcall PPLUS
+ rcall SWOP
+ call CMP
+ breq LIKEQ3
+TWODROPNZ:
+ clz
+ rjmp LIKEQ4
+LIKEQ3:
+ rcall XNEXT
+ brcc LIKEQ1
+TWODROPZ:
+ sez
+LIKEQ4:
+ pop t1
+ pop t0
+ rjmp TWODROP__
+
+;;;;;;;;;;;;;;;;;;;;
+LIKES:
+ rcall TWODUP
+ rcall LIKEQ
+ breq LIKES1
+ rcall DUP
+ rcall DOTID
+ rcall SPACE_
+LIKES1:
+ rcall TWOMINUS
+ rcall FETCH_A
+ rcall DUPZEROSENSE
+ brne LIKES
+TWODROP__:
+ jmp TWODROP
+
+ ; WORDS -- filter
+ fdw TO_PRINTABLE_L
+WORDS_L:
+ .db NFA|5,"words"
+ rcall BL
+ rcall WORD
+ rcall DUP
+ rcall DOLIT
+ fdw kernellink
+ rcall WDS1
+ rcall LATEST_
+ rcall FETCH_A
+WDS1: rcall CR
+ jmp LIKES
+
+; .S -- print stack contents
+; : .s space sp@ s0 @ 2- begin 2dup < while -@ u. repeat 2drop ;
+ fdw WORDS_L
+DOTS_L:
+ .db NFA|2,".s",0
+DOTS:
+ rcall SPACE_
+ rcall DUP
+ call SPFETCH
+ rcall S0
+ rcall FETCH_A
+ rcall TWOMINUS
+DOTS1:
+ rcall TWODUP
+ rcall LESS
+ rcall ZEROSENSE
+ breq DOTS2
+ rcall MINUS_FETCH
+ rcall UDOT
+ rjmp DOTS1
+DOTS2:
+ rcall DROP
+ jmp TWODROP
+
+; DUMP ADDR U -- DISPLAY MEMORY
+ fdw DOTS_L
+DUMP_L:
+ .db NFA|4,"dump",0
+DUMP:
+ rcall DOLIT
+ .dw 16
+ rcall USLASH
+ rcall TOR
+ rjmp DUMP7
+DUMP1:
+ rcall CR
+ rcall DUP
+ rcall DOLIT
+ .dw 4
+ rcall UDOTR
+ rcall DOLIT
+ .dw ':'
+ rcall EMIT_A
+ rcall DOLIT
+ .dw 15
+ rcall TOR
+DUMP2:
+ rcall CFETCHPP
+ rcall DOLIT
+ .dw 2
+ rcall UDOTR
+ rcall XNEXT
+ brcc DUMP2
+ pop t1
+ pop t0
+
+ rcall DOLIT
+ .dw 16
+ rcall MINUS
+ rcall DOLIT
+ .dw 15
+ rcall TOR
+DUMP4:
+ rcall CFETCHPP
+ rcall TO_PRINTABLE
+ rcall EMIT_A
+ rcall XNEXT
+ brcc DUMP4
+ pop t1
+ pop t0
+DUMP7:
+ rcall XNEXT
+ brcc DUMP1
+ pop t1
+ pop t0
+ jmp DROP
+
+; IALLOT n -- allocate n bytes in ROM
+; .dw link
+;link set $
+ .db NFA|1," "
+IALLOT:
+ rcall IDP
+ jmp PLUSSTORE
+
+
+;***************************************************************
+; Store the execcution vector addr to the return stack
+; leave the updated return stack pointer on the data stack
+; x>r ( addr rsp -- rsp' )
+ fdw DUMP_L
+X_TO_R_L:
+ .db NFA|3,"x>r"
+X_TO_R:
+ movw zl, tosl
+ poptos
+ rcall TO_XA
+ adiw zl, 1
+ st -z, tosl
+ st -z, tosh
+.ifdef EIND
+ st -z, r_one
+.endif
+ st -z, r_zero
+ movw tosl, zl
+ ret
+;***************************************************************
+ fdw X_TO_R_L
+TO_XA_L:
+ .db NFA|3,">xa"
+TO_XA:
+ sub_pflash_tos
+ rampv_to_c
+ ror tosh
+ ror tosl
+ ret
+
+ fdw TO_XA_L
+XA_FROM_L:
+ .db NFA|3,"xa>"
+XA_FROM:
+ lsl tosl
+ rol tosh
+ add_pflash_tos
+ ret
+;***************************************************************
+ fdw XA_FROM_L
+PFL_L:
+ .db NFA|3,"pfl"
+PFL:
+ call DOCREATE
+ .dw OFLASH
+;***************************************************************
+ fdw PFL_L
+ZFL_L:
+ .db NFA|3, "zfl"
+ZFL:
+ call DOCREATE
+ .dw RAMPZV
+;***************************************************************
+; ,?0= -- addr Compile ?0= and make make place for a branch instruction
+ .db NFA|4, ",?0=",0 ; Just for see to work !
+COMMAZEROSENSE:
+ sbrc FLAGS1, idup
+ rjmp COMMAZEROSENSE1
+ rcall DOLIT
+ fdw ZEROSENSE
+ rjmp COMMAZEROSENSE2
+COMMAZEROSENSE1:
+ rcall IDPMINUS
+ rcall DOLIT
+ fdw DUPZEROSENSE
+COMMAZEROSENSE2:
+ cbr FLAGS1, (1<<idup)
+ rjmp INLINE0
+
+IDPMINUS:
+ rcall DOLIT
+ .dw -4
+ rjmp IALLOT
+
+; rjmp, ( rel-addr -- )
+RJMPC:
+ rcall TWOSLASH
+ andi tosh, 0x0f
+ ori tosh, 0xc0
+ rjmp ICOMMA__
+
+
+BRCCC:
+ rcall DOLIT
+ .dw 0xf008 ; brcc pc+2
+ rjmp ICOMMA__
+;BREQC:
+; rcall DOLIT
+; .dw 0xf009 ; breq pc+2
+; sbrc FLAGS1, izeroeq
+; ori tosh, 4 ; brne pc+2
+; jmp ICOMMA
+BRNEC:
+ rcall DOLIT
+ .dw 0xf409 ; brne pc+2
+ sbrc FLAGS1, izeroeq
+ andi tosh, ~4
+ rjmp ICOMMA__
+
+; IF -- adrs conditional forward branch
+; Leaves address of branch instruction
+; and compiles the condition byte
+ fdw ZFL_L
+IF_L:
+ .db NFA|IMMED|COMPILE|2,"if",0
+IF_:
+ sbrc FLAGS1, izeroeq
+ rcall IDPMINUS
+ rcall COMMAZEROSENSE
+ rcall BRNEC
+ cbr FLAGS1, (1<<izeroeq)
+ rcall IHERE
+ rcall FALSE_
+ jmp RJMPC ; Dummy, replaced by THEN with rjmp
+
+; ELSE adrs1 -- adrs2 branch for IF..ELSE
+; Leave adrs2 of bra instruction and store bz in adrs1
+; Leave adress of branch instruction and FALSE flag on stack
+ fdw IF_L
+ELSE_L:
+ .db NFA|IMMED|COMPILE|4,"else",0
+ELSE_:
+ rcall IHERE
+ rcall FALSE_
+ rcall RJMPC
+ rcall SWOP_A ; else-addr if-addr
+ jmp THEN_
+
+; THEN adrs -- resolve forward branch
+ fdw ELSE_L
+THEN_L:
+ .db NFA|IMMED|COMPILE|4,"then",0
+THEN_:
+ sbr FLAGS1, (1<<fTAILC) ; Prevent tailjmp optimisation
+ rcall IHERE
+ rcall OVER
+ rcall MINUS
+ rcall TWOMINUS
+ rcall TWOSLASH
+ rcall DOLIT
+ .dw 0xc000 ; back-addr mask
+ rcall OR_
+ rcall SWOP_A
+ jmp STORE
+
+; BEGIN -- adrs target for bwd. branch
+ fdw THEN_L
+BEGIN_L:
+ .db NFA|IMMED|COMPILE|5,"begin"
+BEGIN:
+ jmp IHERE
+
+; UNTIL adrs -- Branch bakwards if true
+ fdw BEGIN_L
+UNTIL_L:
+ .db NFA|IMMED|COMPILE|5,"until"
+UNTIL:
+ sbr FLAGS1, (1<<fTAILC) ; Prevent tailjmp optimisation
+ sbrc FLAGS1, izeroeq
+ rcall IDPMINUS
+ rcall COMMAZEROSENSE
+ rcall BRNEC
+ cbr FLAGS1, (1<<izeroeq)
+ jmp AGAIN_
+
+ ; AGAIN adrs -- uncond'l backward branch
+; unconditional backward branch
+ fdw UNTIL_L
+AGAIN_L:
+ .db NFA|IMMED|COMPILE|5,"again"
+AGAIN_:
+ sbr FLAGS1, (1<<fTAILC) ; Prevent tailjmp optimisation
+ rcall IHERE
+ rcall MINUS
+ rcall TWOMINUS
+ jmp RJMPC
+
+; WHILE addr1 -- addr2 addr1 branch for WHILE loop
+; addr1 : address of BEGIN
+; addr2 : address where to store bz instruction
+ fdw AGAIN_L
+WHILE_L:
+ .db NFA|IMMED|COMPILE|5,"while"
+WHILE_:
+ rcall IF_
+ jmp SWOP
+
+; REPEAT addr2 addr1 -- resolve WHILE loop
+ fdw WHILE_L
+REPEAT_L:
+ .db NFA|IMMED|COMPILE|6,"repeat",0
+REPEAT_:
+ rcall AGAIN_
+ jmp THEN_
+
+ fdw REPEAT_L
+INLINE_L:
+ .db NFA|IMMED|COMPILE|6,"inline",0
+ cbr FLAGS1, (1<<izeroeq)
+ cbr FLAGS1, (1<<idup)
+ rcall TICK
+ jmp INLINE0
+; in, ( addr -- ) begin @+ dup $9508 <> while i, repeat 2drop ;
+ fdw INLINE_L
+INLINEC_L:
+ .db NFA|3,"in,"
+INLINE0:
+ rcall FETCHPP
+ rcall DUP
+ rcall DOLIT
+ .dw 0x9508
+ rcall NOTEQUAL
+ rcall ZEROSENSE
+ breq INLINE1
+ rcall ICOMMA
+ rjmp INLINE0
+INLINE1:
+ jmp TWODROP
+
+; FOR -- bc-addr bra-addr
+ fdw INLINEC_L
+FOR_L:
+ .db NFA|IMMED|COMPILE|3,"for"
+FOR:
+ call DOCOMMAXT
+ fdw TOR
+ rcall IHERE
+ rcall FALSE_
+ rcall RJMPC
+ rcall IHERE
+ jmp SWOP
+
+; NEXT bra-addr bc-addr --
+ fdw FOR_L
+NEXT_L:
+ .db NFA|IMMED|COMPILE|4,"next", 0
+NEXT:
+ rcall THEN_
+ call DOCOMMAXT
+ fdw XNEXT
+ rcall BRCCC
+
+ rcall AGAIN_
+
+ rcall DOLIT
+ fdw XNEXT1
+ jmp INLINE0
+; (next) decrement top of return stack
+ .db NFA|7,"(next) "
+XNEXT:
+ m_pop_zh
+ pop zh
+ pop zl
+ pop xh
+ pop xl
+ sbiw xl, 1
+ push xl
+ push xh
+ mijmp
+ ret
+XNEXT1:
+ pop t1
+ pop t0
+ ret
+
+; leave clear top of return stack
+ fdw NEXT_L
+LEAVE_L:
+ .db NFA|COMPILE|5,"endit"
+LEAVE:
+ m_pop_zh
+ pop zh
+ pop zl
+ pop t1
+ pop t0
+ push r_zero
+ push r_zero
+ mijmp
+;***************************************************
+; RDROP compile a pop
+ fdw LEAVE_L
+RDROP_L:
+ .db NFA|IMMED|COMPILE|5,"rdrop"
+RDROP:
+ rcall DOLIT
+ fdw XNEXT1
+ jmp INLINE0
+;***************************************************
+ fdw RDROP_L
+STOD_L:
+ .db NFA|3,"s>d"
+STOD:
+ sbrs tosh, 7
+ rjmp FALSE_
+ rjmp TRUE_
+;***************************************************
+ fdw STOD_L
+DNEGATE_L:
+ .db NFA|7,"dnegate"
+DNEGATE:
+ rcall DINVERT
+ call ONE
+ jmp MPLUS
+;***************************************************
+ fdw DNEGATE_L
+QDNEGATE_L:
+ .db NFA|8,"?dnegate",0
+QDNEGATE:
+ rcall ZEROLESS
+ rcall ZEROSENSE
+ breq QDNEGATE1
+ rcall DNEGATE
+QDNEGATE1:
+ ret
+
+;***************************************************
+ fdw QDNEGATE_L
+DABS_L:
+ .db NFA|4,"dabs",0
+DABS:
+ rcall DUP
+ jmp QDNEGATE
+;***************************************************
+ fdw DABS_L
+DPLUS_L:
+ .db NFA|2,"d+",0
+DPLUS:
+ ld xl, Y+
+ ld xh, Y+
+ ld t6, Y+
+ ld t7, Y+
+ ld t0, Y+
+ ld t1, Y+
+ add xl, t0
+ adc xh, t1
+ adc tosl, t6
+ adc tosh, t7
+ st -Y, xh
+ st -Y, xl
+ ret
+
+;***************************************************
+ fdw DPLUS_L
+DMINUS_L:
+ .db NFA|2,"d-",0
+DMINUS:
+ rcall DNEGATE
+ jmp DPLUS
+;***************************************************
+ fdw DMINUS_L
+DTWOSLASH_L:
+ .db NFA|3,"d2/"
+ ld t0, y+
+ ld t1, y+
+ asr tosh
+ ror tosl
+ ror t1
+ ror t0
+ st -y, t1
+ st -y, t0
+ ret
+;***************************************************
+ fdw DTWOSLASH_L
+DTWOSTAR_L:
+ .db NFA|3,"d2*"
+ ld t0, y+
+ ld t1, y+
+ lsl t0
+ rol t1
+ rol tosl
+ rol tosh
+ st -y, t1
+ st -y, t0
+ ret
+;***************************************************
+ fdw DTWOSTAR_L
+DINVERT_L:
+ .db NFA|7,"dinvert"
+DINVERT:
+ ld t0, y+
+ ld t1, y+
+ com t0
+ com t1
+ com tosl
+ com tosh
+ st -y, t1
+ st -y, t0
+ ret
+;***************************************************
+ fdw DINVERT_L
+DZEROEQUAL_L:
+ .db NFA|3,"d0="
+DZEROEQUAL:
+ ld xl, y+
+ ld xh, y+
+ or tosl, tosh
+ or tosl, xl
+ or tosl, xh
+ brne DZEROLESS_FALSE
+DZEROEQUAL_TRUE:
+ ser tosl
+ ser tosh
+ ret
+
+;***************************************************
+ fdw DZEROEQUAL_L
+DZEROLESS_L:
+ .db NFA|3,"d0<"
+DZEROLESS:
+ ld xl, y+
+ ld xh, y+
+ cpi tosh, 0
+ brmi DZEROEQUAL_TRUE
+DZEROLESS_FALSE:
+ clr tosl
+ clr tosh
+ ret
+;***************************************************
+ fdw DZEROLESS_L
+DEQUAL_L:
+ .db NFA|2,"d=",0
+ rcall DMINUS
+ jmp DZEROEQUAL
+;***************************************************
+ fdw DEQUAL_L
+DLESS_L:
+ .db NFA|2,"d<",0
+DLESS:
+ rcall DMINUS
+ jmp DZEROLESS
+;***************************************************
+ fdw DLESS_L
+DGREATER_L:
+ .db NFA|2,"d>",0
+DGREATER:
+ call TWOSWAP
+ jmp DLESS
+;***************************************************
+ fdw DGREATER_L
+UDDOT_L:
+ .db NFA|3,"ud."
+ rcall LESSNUM
+ rcall NUMS
+ rcall NUMGREATER
+ call TYPE
+ jmp SPACE_
+;***************************************************
+ fdw UDDOT_L
+DDOT_L:
+ .db NFA|2,"d.",0
+ rcall LESSNUM
+ push tosl ; dup >r
+ push tosh
+ rcall DABS
+ rcall NUMS
+ call RFROM
+ rcall SIGN
+ rcall NUMGREATER
+ call TYPE
+ jmp SPACE_
+;****************************************************
+ fdw DDOT_L
+MEMHI_L:
+ .db NFA|2,"hi",0
+MEMHI:
+ rcall DOLIT
+ fdw FLASHHI
+ call CSE_
+ call PLUS
+ jmp FETCH
+FLASHHI:
+ .dw FLASH_HI
+ .dw EEPROM_HI
+ .dw RAM_HI
+
+.if FLASHEND > 0x3fff
+;;; x@ ( addrl addru -- x )
+ fdw A_FROM_L
+XFETCH_L:
+ .db NFA|2, "x@",0
+.ifdef RAMPZ
+ out_ RAMPZ, tosl
+.endif
+ poptos
+ movw z, tosl
+ lpm_ tosl, z+ ; Fetch from Flash directly
+ lpm_ tosh, z+
+.ifdef RAMPZ
+ ldi t0, RAMPZV
+ out_ RAMPZ, t0
+.endif
+ ret
+
+;;; x! ( x addrl addru -- )
+ fdw XFETCH_L
+XSTORE_L:
+ .db NFA|2, "x!",0
+ mov t0, tosl
+ call DROP
+ rcall XUPDATEBUF
+ rjmp ISTORE1
+.endif
+
+;***************************************************
+
+ fdw MEMHI_L
+L_FETCH_P:
+ .db NFA|INLINE|2,"@p", 0
+FETCH_P:
+ pushtos
+ movw tosl, pl
+ ret
+;***************************************************
+ fdw L_FETCH_P
+L_PCFETCH:
+ .db NFA|3,"pc@" ; ( -- c ) Fetch char from pointer
+PCFETCH:
+ pushtos
+ movw tosl, pl
+ jmp CFETCH
+;***************************************************
+ fdw L_PCFETCH
+L_PTWOPLUS:
+kernellink:
+ .db NFA|INLINE|3,"p2+" ; ( n -- ) Add 2 to p
+PTWOPLUS:
+ add pl, r_two
+ adc ph, r_zero
+ ret
+
+;***************************************************
+; marker --- name
+ .dw 0
+L_MARKER:
+lastword:
+ .db NFA|6,"marker",0
+MARKER:
+ call ROM_
+ rcall CREATE
+ rcall DOLIT
+ .dw dp_start
+ call HERE
+ rcall TEN
+ rcall CMOVE
+ rcall TEN
+ call ALLOT
+ call FRAM
+ rcall XDOES
+ call DODOES
+ rcall INI
+ rcall TEN
+ jmp CMOVE
+
+.if IDLE_MODE == 1
+.if CPU_LOAD_LED == 1
+;;; Enable load led
+ fdw BUSY_L
+LOADON_L:
+ .db NFA|5,"load+"
+ sbr FLAGS2, (1<<fLOADled)
+ ret
+
+;;; Disable load led
+ fdw LOADON_L
+LOADOFF_L:
+ .db NFA|5,"load-"
+ cbr FLAGS2, (1<<fLOADled)
+.if CPU_LOAD_LED == 1
+ cbi_ CPU_LOAD_DDR, CPU_LOAD_BIT
+.if CPU_LOAD_LED_POLARITY == 1
+ cbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.else
+ sbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.endif
+.endif
+ ret
+.endif
+;;;
+.if CPU_LOAD == 1
+.if CPU_LOAD_LED == 1
+ fdw LOADOFF_L
+.else
+ fdw BUSY_L
+.endif
+LOAD_L:
+ .db NFA|4,"load",0
+ rcall DUP
+ lds tosl, load_res
+ lds tosh, load_res+1
+ rcall DUP
+ lds tosl, load_res+2
+ clr tosh
+ rcall DUP
+ ldi tosl, low(CPU_LOAD_VAL)
+ ldi tosh, high(CPU_LOAD_VAL)
+ call UMSLASHMOD
+ jmp NIP
+.endif
+.endif
+
+.ifdef UCSR1A
+;***************************************************
+; TX1 c -- output character to UART 1
+ fdw RX0Q_L
+TX1_L:
+ .db NFA|3,"tx1"
+TX1_:
+ cpi tosl, XON
+ breq XXON_TX1_TOS
+ cpi tosl, XOFF
+ breq XXOFF_TX1_TOS
+TX1_LOOP:
+ rcall PAUSE
+ in_ t0, UCSR1A
+ sbrs t0, UDRE1
+ rjmp TX1_LOOP
+ out_ UDR1, tosl
+ poptos
+ ret
+
+XXON_TX1_TOS:
+ poptos
+ rjmp XXON_TX1_1
+XXON_TX1:
+ sbrs FLAGS2, ixoff_tx1
+ ret
+XXON_TX1_1:
+ cbr FLAGS2, (1<<ixoff_tx1)
+ ldi zh, XON
+ rjmp TX1_SEND
+
+XXOFF_TX1_TOS:
+ poptos
+ rjmp XXOFF_TX1_1
+XXOFF_TX1:
+ sbrc FLAGS2, ixoff_tx1
+ ret
+XXOFF_TX1_1:
+ sbr FLAGS2, (1<<ixoff_tx1)
+ ldi zh, XOFF
+TX1_SEND:
+ in_ zl, UCSR1A
+ sbrs zl, UDRE1
+ rjmp TX1_SEND
+ out_ UDR1, zh
+ ret
+;***************************************************
+; RX1 -- c get character from the serial line
+ fdw TX1_L
+RX1_L:
+ .db NFA|3,"rx1"
+RX1_:
+ rcall PAUSE
+ rcall RX1Q
+ call ZEROSENSE
+ breq RX1_
+ pushtos
+ ldi zl, low(rbuf1)
+ ldi zh, high(rbuf1)
+ lds xl, rbuf1_rd
+ add zl, xl
+ adc zh, r_zero
+ ld tosl, z
+ clr tosh
+ in_ t0, SREG
+ cli
+ inc xl
+ andi xl, (RX1_BUF_SIZE-1)
+ sts rbuf1_rd, xl
+ lds xl, rbuf1_lv
+ dec xl
+ sts rbuf1_lv, xl
+ out_ SREG, t0
+ ret
+;***************************************************
+; RX1? -- n return the number of characters in queue
+ fdw RX1_L
+RX1Q_L:
+ .db NFA|4,"rx1?",0
+RX1Q:
+ lds xl, rbuf1_lv
+ cpse xl, r_zero
+ jmp TRUE_
+.if U1FC_TYPE == 1
+ rcall XXON_TX1
+.endif
+.if U1FC_TYPE == 2
+ cbi_ U1RTS_PORT, U1RTS_BIT
+.endif
+ jmp FALSE_
+
+;****************************************************
+RX1_ISRR:
+ ldi zl, low(rbuf1)
+ ldi zh, high(rbuf1)
+ lds xl, rbuf1_wr
+ add zl, xl
+ adc zh, r_zero
+ in_ xh, UDR1
+.if OPERATOR_UART == 1
+.if CTRL_O_WARM_RESET == 1
+ cpi xh, 0xf
+ brne pc+2
+ rjmp RESET_
+.endif
+.endif
+ st z, xh
+ inc xl
+ andi xl, (RX1_BUF_SIZE-1)
+ sts rbuf1_wr, xl
+ lds xl, rbuf1_lv
+ inc xl
+ sts rbuf1_lv, xl
+ cpi xl, RX1_BUF_SIZE-2
+ brne PC+2
+ rcall RX1_OVF
+ cpi xl, RX0_OFF_FILL
+ brmi RX1_ISR_SKIP_XOFF
+.if U1FC_TYPE == 1
+ rcall XXOFF_TX1_1
+.endif
+.if U1FC_TYPE == 2
+ sbi_ U1RTS_PORT, U1RTS_BIT
+.endif
+RX1_ISR_SKIP_XOFF:
+ rjmp FF_ISR_EXIT
+RX1_OVF:
+ ldi zh, '|'
+ rjmp TX1_SEND
+TX1_ISR:
+.endif
+;***************************************************
+RQ_EMIT:
+ sbrs t2, PORF
+ rjmp RQ_EXTR
+ rcall DOLIT
+ .dw 'P'
+ rcall EMIT_A
+RQ_EXTR:
+ sbrs t2, EXTRF
+ rjmp RQ_BORF
+ rcall DOLIT
+ .dw 'E'
+ rcall EMIT_A
+RQ_BORF:
+ sbrs t2, BORF
+ rjmp RQ_WDRF
+ rcall DOLIT
+ .dw 'B'
+ rcall EMIT_A
+RQ_WDRF:
+ sbrs t2, WDRF
+ rjmp RQ_DIVZERO
+ rcall DOLIT
+ .dw 'W'
+ rcall EMIT_A
+RQ_DIVZERO:
+ sbrs t3, 6 ; T bit MATH error
+ rjmp RQ_END
+ rcall DOLIT
+ .dw 'M'
+ rcall EMIT_A
+RQ_END:
+ jmp SPACE_
+
+;*****************************************************
+.if IDLE_MODE == 1
+IDLE_LOAD:
+.if CPU_LOAD == 1
+ sbrs FLAGS2, fLOAD
+ rjmp CPU_LOAD_END
+ in_ t0, SREG
+ cli
+ cbr FLAGS2, (1<<fLOAD)
+ sts load_res, loadreg0
+ sts load_res+1,loadreg1
+ sts load_res+2, loadreg2
+ clr loadreg0
+ clr loadreg1
+ clr loadreg2
+ out_ SREG, t0
+CPU_LOAD_END:
+.endif
+.if CPU_LOAD_LED == 1
+ sbrs FLAGS2, fLOADled
+ rjmp LOAD_LED_END
+ sbi_ CPU_LOAD_DDR, CPU_LOAD_BIT
+.if CPU_LOAD_LED_POLARITY == 1
+ cbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.else
+ sbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.endif
+LOAD_LED_END:
+.endif
+ sbrs FLAGS2, fIDLE
+ rjmp IDLE_LOAD1
+ ldi t0, low(up0)
+ cp upl, t0
+ brne IDLE_LOAD1
+.ifdef SMCR
+ ldi t0, (1<<SE)
+ out_ SMCR, t0
+.else
+ in_ t0, MCUCR
+ sbr t0, (1<<SE)
+ out_ MCUCR, t0
+.endif
+.if CPU_LOAD == 1
+ out_ TCCR1B, r_zero ; Stop load counter
+.endif
+ sleep ; IDLE mode
+.ifdef SMCR
+ out_ SMCR, r_zero
+.else
+ in_ t0, MCUCR
+ cbr t0, (1<<SE)
+ out_ MCUCR, r_zero
+.endif
+IDLE_LOAD1:
+.if CPU_LOAD_LED == 1
+ sbrc FLAGS2, fLOADled
+.if CPU_LOAD_LED_POLARITY == 1
+ sbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.else
+ cbi_ CPU_LOAD_PORT, CPU_LOAD_BIT
+.endif
+.endif
+ ret
+.endif
+end_of_dict:
+
+;FF_DP code:
+dpcode:
+;****************************************************
+; org h'f00000'
+; de h'ff', h'ff'
+; de dp_user_dictionary&0xff, (dp_user_dictionary>>8)&0xff
+; de dpeeprom&0xff, (dpeeprom>>8)&0xff
+; de (dpdata)&0xff, ((dpdata)>>8)&0xff
+; de lastword_lo, lastword_hi
+; de DOTSTATUS;&0xff;, (DOTSTATUS>>8)&0xff
+
+; .end
+;**********************************************************
+.cseg
+.org BOOT_START
+RESET_: jmp WARM_
+.org BOOT_START + 0x02
+ rcall FF_ISR
+.org BOOT_START + 0x04
+ rcall FF_ISR
+.org BOOT_START + 0x06
+ rcall FF_ISR
+.org BOOT_START + 0x08
+.if MS_TIMER_ADDR == 0x08
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x0a
+ rcall FF_ISR
+.org BOOT_START + 0x0c
+ rcall FF_ISR
+.org BOOT_START + 0x0e
+.if MS_TIMER_ADDR == 0x0e
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x10
+ rcall FF_ISR
+.org BOOT_START + 0x12
+.if MS_TIMER_ADDR == 0x12
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x14
+.if MS_TIMER_ADDR == 0x14
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x16
+.if MS_TIMER_ADDR == 0x16
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x18
+.if MS_TIMER_ADDR == 0x18
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x1a
+.if MS_TIMER_ADDR == 0x1a
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x1c
+.if MS_TIMER_ADDR == 0x1c
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x1e
+.if MS_TIMER_ADDR == 0x1e
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x20
+.if MS_TIMER_ADDR == 0x20
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x22
+.if MS_TIMER_ADDR == 0x22
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.org BOOT_START + 0x24
+ rcall FF_ISR
+.if 0x26 < INT_VECTORS_SIZE
+.org BOOT_START + 0x26
+ rcall FF_ISR
+.endif
+.if 0x28 < INT_VECTORS_SIZE
+.org BOOT_START + 0x28
+ rcall FF_ISR
+.endif
+.if 0x2a < INT_VECTORS_SIZE
+.org BOOT_START + 0x2a
+.if MS_TIMER_ADDR == 0x2a
+ rjmp MS_TIMER_ISR
+.else
+ rcall FF_ISR
+.endif
+.endif
+.if 0x2c < INT_VECTORS_SIZE
+.org BOOT_START + 0x2c
+ rcall FF_ISR
+.endif
+.if 0x2e < INT_VECTORS_SIZE
+.org BOOT_START + 0x2e
+ rcall FF_ISR
+.endif
+.if 0x30 < INT_VECTORS_SIZE
+.org BOOT_START + 0x30
+ rcall FF_ISR
+.endif
+.if 0x32 < INT_VECTORS_SIZE
+.org BOOT_START + 0x32
+ rcall FF_ISR
+.endif
+.if 0x34 < INT_VECTORS_SIZE
+.org BOOT_START + 0x34
+ rcall FF_ISR
+.endif
+.if 0x36 < INT_VECTORS_SIZE
+.org BOOT_START + 0x36
+ rcall FF_ISR
+.endif
+.if 0x38 < INT_VECTORS_SIZE
+.org BOOT_START + 0x38
+ rcall FF_ISR
+.endif
+.if 0x3a < INT_VECTORS_SIZE
+.org BOOT_START + 0x3a
+ rcall FF_ISR
+.endif
+.if 0x3c < INT_VECTORS_SIZE
+.org BOOT_START + 0x3c
+ rcall FF_ISR
+.endif
+.if 0x3e < INT_VECTORS_SIZE
+.org BOOT_START + 0x3e
+ rcall FF_ISR
+.endif
+.if 0x40 < INT_VECTORS_SIZE
+.org BOOT_START + 0x40
+ rcall FF_ISR
+.endif
+.if 0x42 < INT_VECTORS_SIZE
+.org BOOT_START + 0x42
+ rcall FF_ISR
+.endif
+.if 0x44 < INT_VECTORS_SIZE
+.org BOOT_START + 0x44
+ rcall FF_ISR
+.endif
+.if 0x46 < INT_VECTORS_SIZE
+.org BOOT_START + 0x46
+ rcall FF_ISR
+.endif
+.if 0x48 < INT_VECTORS_SIZE
+.org BOOT_START + 0x48
+ rcall FF_ISR
+.endif
+.if 0x4a < INT_VECTORS_SIZE
+.org BOOT_START + 0x4a
+ rcall FF_ISR
+.endif
+.if 0x4c < INT_VECTORS_SIZE
+.org BOOT_START + 0x4c
+ rcall FF_ISR
+.endif
+.if 0x4e < INT_VECTORS_SIZE
+.org BOOT_START + 0x4e
+ rcall FF_ISR
+.endif
+.if 0x50 < INT_VECTORS_SIZE
+.org BOOT_START + 0x50
+ rcall FF_ISR
+.endif
+.if 0x52 < INT_VECTORS_SIZE
+.org BOOT_START + 0x52
+ rcall FF_ISR
+.endif
+.if 0x54 < INT_VECTORS_SIZE
+.org BOOT_START + 0x54
+ rcall FF_ISR
+.endif
+.if 0x56 < INT_VECTORS_SIZE
+.org BOOT_START + 0x56
+ rcall FF_ISR
+.endif
+.if 0x58 < INT_VECTORS_SIZE
+.org BOOT_START + 0x58
+ rcall FF_ISR
+.endif
+.if 0x5a < INT_VECTORS_SIZE
+.org BOOT_START + 0x5a
+ rcall FF_ISR
+.endif
+.if 0x5c < INT_VECTORS_SIZE
+.org BOOT_START + 0x5c
+ rcall FF_ISR
+.endif
+.if 0x5e < INT_VECTORS_SIZE
+.org BOOT_START + 0x5e
+ rcall FF_ISR
+.endif
+.if 0x60 < INT_VECTORS_SIZE
+.org BOOT_START + 0x60
+ rcall FF_ISR
+.endif
+.if 0x62 < INT_VECTORS_SIZE
+.org BOOT_START + 0x62
+ rcall FF_ISR
+.endif
+.if 0x64 < INT_VECTORS_SIZE
+.org BOOT_START + 0x64
+ rcall FF_ISR
+.endif
+.if 0x66 < INT_VECTORS_SIZE
+.org BOOT_START + 0x66
+ rcall FF_ISR
+.endif
+.if 0x68 < INT_VECTORS_SIZE
+.org BOOT_START + 0x68
+ rcall FF_ISR
+.endif
+.if 0x6a < INT_VECTORS_SIZE
+.org BOOT_START + 0x6a
+ rcall FF_ISR
+.endif
+.if 0x6c < INT_VECTORS_SIZE
+.org BOOT_START + 0x6c
+ rcall FF_ISR
+.endif
+.if 0x6e < INT_VECTORS_SIZE
+.org BOOT_START + 0x6e
+ rcall FF_ISR
+.endif
+.if 0x70 < INT_VECTORS_SIZE
+.org BOOT_START + 0x70
+ rcall FF_ISR
+.endif
+
+.org BOOT_START + INT_VECTORS_SIZE - 1
+FF_ISR_EXIT:
+ pop tosh
+ pop tosl
+ pop t1
+ pop t0
+ pop zh
+ pop zl
+MS_TIMER_ISR_EXIT:
+ ld xl, y+
+ ld xh, y+
+ out_ SREG, xh
+ ld xh, y+
+ reti
+
+FF_ISR:
+.if IDLE_MODE == 1
+.if CPU_LOAD == 1
+ out_ TCCR1B, r_one ; Start load counter
+.endif
+.endif
+ st -y, xh
+ in_ xh, SREG
+ st -y, xh
+ st -y, xl
+ m_pop_xh
+ pop xh
+ pop xl
+ push zl
+ push zh
+ push t0
+ push t1
+ push tosl
+ push tosh
+.if low(ivec) == 0x80
+ ldi xh, low(ivec-1)
+ add xl, xh
+.else
+ subi xl, 1
+.endif
+ ldi xh, high(ivec)
+ ld zl, x+
+ ld zh, x+
+ mijmp ;(z)
+
+;;; *************************************************
+MS_TIMER_ISR:
+.if IDLE_MODE == 1
+.if CPU_LOAD == 1
+ out_ TCCR1B, r_one ; Start load counter
+.endif
+.endif
+ st -y, xh
+ in_ xh, SREG
+ st -y, xh
+ st -y, xl
+ add ms_count, r_one
+ adc ms_count1, r_zero
+.if CPU_LOAD == 1
+LOAD_ADD:
+ in_ xl, TCNT1L
+ in_ xh, TCNT1H
+ out_ TCNT1H, r_zero
+ out_ TCNT1L, r_two
+
+ add loadreg0, xl
+ adc loadreg1, xh
+ adc loadreg2, r_zero
+
+ tst ms_count
+ brne LOAD_ADD_END
+ sbr FLAGS2, (1<<fLOAD)
+LOAD_ADD_END:
+.endif
+ rjmp MS_TIMER_ISR_EXIT
+;;; ***************************************************
+RX0_ISR:
+ ldi zl, low(rbuf0)
+ ldi zh, high(rbuf0)
+ lds xl, rbuf0_wr
+ add zl, xl
+ adc zh, r_zero
+ in_ xh, UDR0_
+.if OPERATOR_UART == 0
+.if CTRL_O_WARM_RESET == 1
+ cpi xh, 0xf
+ brne pc+2
+ rjmp RESET_
+.endif
+.endif
+ st z, xh
+ inc xl
+ andi xl, (RX0_BUF_SIZE-1)
+ sts rbuf0_wr, xl
+ lds xl, rbuf0_lv
+ inc xl
+ sts rbuf0_lv, xl
+ cpi xl, RX0_BUF_SIZE-2
+ brne PC+2
+ rcall RX0_OVF
+ cpi xl, RX0_OFF_FILL
+ brmi RX0_ISR_SKIP_XOFF
+.if U0FC_TYPE == 1
+ rcall XXOFF_TX0_1
+.endif
+.if U0FC_TYPE == 2
+ sbi_ U0RTS_PORT, U0RTS_BIT
+.endif
+RX0_ISR_SKIP_XOFF:
+ rjmp FF_ISR_EXIT
+RX0_OVF:
+ ldi zh, '|'
+ rjmp TX0_SEND
+TX0_ISR:
+
+.ifdef UCSR1A
+RX1_ISR: rjmp RX1_ISRR
+.endif
+;***************************************************
+; TX0 c -- output character to UART 0
+.if IDLE_MODE == 1
+.if CPU_LOAD == 1
+ fdw(LOAD_L)
+.else
+.if CPU_LOAD_LED == 1
+ fdw(LOADOFF_L)
+.else
+ fdw(BUSY_L)
+.endif
+.endif
+.else
+ fdw(EXIT_L)
+.endif
+TX0_L:
+ .db NFA|3,"tx0"
+TX0_:
+.if U0FC_TYPE == 1
+ cpi tosl, XON
+ breq XXON_TX0_TOS
+ cpi tosl, XOFF
+ breq XXOFF_TX0_TOS
+.endif
+TX0_LOOP:
+ rcall PAUSE
+ in_ t0, UCSR0A
+ sbrs t0, 5 ; UDRE0, UDRE USART Data Register Empty
+ rjmp TX0_LOOP
+ out_ UDR0_, tosl
+ poptos
+ ret
+
+.if U0FC_TYPE == 1
+XXON_TX0_TOS:
+ poptos
+ rjmp XXON_TX0_1
+XXON_TX0:
+ sbrs FLAGS2, ixoff_tx0
+ ret
+XXON_TX0_1:
+ cbr FLAGS2, (1<<ixoff_tx0)
+ ldi zh, XON
+ rjmp TX0_SEND
+
+XXOFF_TX0_TOS:
+ poptos
+ rjmp XXOFF_TX0_1
+XXOFF_TX0:
+ sbrc FLAGS2, ixoff_tx0
+ ret
+XXOFF_TX0_1:
+ sbr FLAGS2, (1<<ixoff_tx0)
+ ldi zh, XOFF
+.endif
+TX0_SEND:
+ in_ zl, UCSR0A
+ sbrs zl, 5 ; UDRE0, UDRE USART Data Register Empty
+ rjmp TX0_SEND
+ out_ UDR0_, zh
+ ret
+;***************************************************
+; RX0 -- c get character from the UART 0 buffer
+ fdw(TX0_L)
+RX0_L:
+ .db NFA|3,"rx0"
+RX0_:
+ rcall PAUSE
+ rcall RX0Q
+ call ZEROSENSE
+ breq RX0_
+ pushtos
+ ldi zl, low(rbuf0)
+ ldi zh, high(rbuf0)
+ lds xl, rbuf0_rd
+ add zl, xl
+ adc zh, r_zero
+ ld tosl, z
+ clr tosh
+ in_ t0, SREG
+ cli
+ inc xl
+ andi xl, (RX0_BUF_SIZE-1)
+ sts rbuf0_rd, xl
+ lds xl, rbuf0_lv
+ dec xl
+ sts rbuf0_lv, xl
+ out_ SREG, t0
+ ret
+;***************************************************
+; RX0? -- n return the number of characters in queue
+ fdw RX0_L
+RX0Q_L:
+ .db NFA|4,"rx0?",0
+RX0Q:
+ lds xl, rbuf0_lv
+ cpse xl, r_zero
+ jmp TRUE_
+.if U0FC_TYPE == 1
+ rcall XXON_TX0
+.endif
+.if U0FC_TYPE == 2
+ cbi_ U0RTS_PORT, U0RTS_BIT
+.endif
+ jmp FALSE_
+
+
+;*************************************************************
+ ISTORERR:
+ rcall DOTS
+ call XSQUOTE
+ .db 3,"AD?"
+ call TYPE
+ rjmp ABORT
+
+; Coded for max 256 byte pagesize !
+;if (ibaselo != (iaddrlo&(~(PAGESIZEB-1))))(ibaseh != iaddrh)(ibaseu != iaddru)
+; if (idirty)
+; writebuffer_to_imem
+; endif
+; fillbuffer_from_imem
+; ibaselo = iaddrlo&(~(PAGESIZEB-1))
+; ibasehi = iaddrhi
+;endif
+IUPDATEBUF:
+ sub_pflash_tos
+.ifdef RAMPZ
+ ldi t0, RAMPZV
+.endif
+XUPDATEBUF:
+ sts iaddrl, tosl
+ sts iaddrh, tosh
+.ifdef RAMPZ
+ sts iaddru, t0
+ cpi t0, RAMPZV
+ brne XUPDATEBUF2
+.endif
+ cpi tosh, high(FLASH_HI-PFLASH+1) ; Dont allow kernel writes
+ brcc ISTORERR
+XUPDATEBUF2:
+ lds t0, iaddrl
+ andi t0, ~(PAGESIZEB-1)
+ cpse t0, ibasel
+ rjmp IFILL_BUFFER
+ lds t0, iaddrh
+ cpse t0, ibaseh
+ rjmp IFILL_BUFFER
+.ifdef RAMPZ
+ lds t0, iaddru
+ lds t1, ibaseu
+ cpse t0, t1
+ rjmp IFILL_BUFFER
+.endif
+ ret
+
+IFILL_BUFFER:
+ rcall IFLUSH
+ lds t0, iaddrl
+ andi t0, ~(PAGESIZEB-1)
+ mov ibasel, t0
+ lds ibaseh, iaddrh
+.ifdef RAMPZ
+ lds t0, iaddru
+ sts ibaseu, t0
+ out_ RAMPZ, t0
+.endif
+IFILL_BUFFER_1:
+ ldi t0, PAGESIZEB&0xff ; 0x100 max PAGESIZEB
+ movw zl, ibasel
+ ldi xl, low(ibuf)
+ ldi xh, high(ibuf)
+IFILL_BUFFER_2:
+ lpm_ t1, z+
+ st x+, t1
+ dec t0
+ brne IFILL_BUFFER_2
+.ifdef RAMPZ
+ ldi t0, RAMPZV
+ out_ RAMPZ, t0
+.endif
+ ret
+
+IWRITE_BUFFER:
+.if OPERATOR_UART == 0
+.if U0FC_TYPE == 1
+ rcall DOLIT
+ .dw XOFF
+ call EMIT
+.endif
+.if U0FC_TYPE == 2
+ sbi_ U0RTS_PORT, U0RTS_BIT
+.endif
+.else ;; UART1
+.if U1FC_TYPE == 1
+ rcall DOLIT
+ .dw XOFF
+ call EMIT
+.endif
+.if U1FC_TYPE == 2
+ sbi_ U1RTS_PORT, U1RTS_BIT
+.endif
+.endif
+ rcall DOLIT
+ .dw 10
+ rcall MS
+ ; Disable interrupts
+ cli
+ movw zl, ibasel
+.ifdef RAMPZ
+ lds t0, ibaseu
+ out_ RAMPZ, t0
+.endif
+ ldi t1, (1<<PGERS) | (1<<SPMEN) ; Page erase
+ rcall DO_SPM
+ ldi t1, (1<<RWWSRE) | (1<<SPMEN); re-enable the RWW section
+ rcall DO_SPM
+
+ ; transfer data from RAM to Flash page buffer
+ ldi t0, low(PAGESIZEB);init loop variable
+ ldi xl, low(ibuf)
+ ldi xh, high(ibuf)
+ push r0
+ push r1
+IWRITE_BUFFER1:
+ ld r0, x+
+ ld r1, x+
+ ldi t1, (1<<SPMEN)
+ rcall DO_SPM
+ adiw zl, 2
+ subi t0, 2
+ brne IWRITE_BUFFER1
+
+ ; execute page write
+ subi zl, low(PAGESIZEB) ;restore pointer
+ sbci zh, high(PAGESIZEB)
+ ldi t1, (1<<PGWRT) | (1<<SPMEN)
+ rcall DO_SPM
+ ; re-enable the RWW section
+ rcall IWRITE_BUFFER3
+
+ ; read back and check, optional
+ ldi t0, low(PAGESIZEB);init loop variable
+ subi xl, low(PAGESIZEB) ;restore pointer
+ sbci xh, high(PAGESIZEB)
+IWRITE_BUFFER2:
+ lpm_ r0, z+
+ ld r1, x+
+ cpse r0, r1
+ rjmp WARM_ ; reset
+ subi t0, 1
+ brne IWRITE_BUFFER2
+ pop r1
+ pop r0
+ ser t0
+ mov ibaseh, t0
+.ifdef RAMPZ
+ sts ibaseu, t0
+.endif
+.ifdef RAMPZ
+ ldi t0, RAMPZV
+ out_ RAMPZ, t0
+.endif
+ cbr FLAGS1, (1<<idirty)
+ // reenable interrupts
+ sei
+.if OPERATOR_UART == 0
+.if U0FC_TYPE == 1
+ rcall DOLIT
+ .dw XON
+ call EMIT
+.endif
+.if U0FC_TYPE == 2
+ cbi_ U0RTS_PORT, U0RTS_BIT
+.endif
+.else
+.if U1FC_TYPE == 1
+ rcall DOLIT
+ .dw XON
+ call EMIT
+.endif
+.if U1FC_TYPE == 2
+ cbi_ U1RTS_PORT, U1RTS_BIT
+.endif
+.endif
+.if DEBUG_FLASH == 1
+ rcall DOLIT
+ .dw 'F'
+ call EMIT
+.endif
+ ret
+ ; ret to RWW section
+ ; verify that RWW section is safe to read
+IWRITE_BUFFER3:
+ in_ t8, SPMCSR
+ sbrs t8, RWWSB ; If RWWSB is set, the RWW section is not ready yet
+ ret
+ ; re-enable the RWW section
+ ldi t1, (1<<RWWSRE) | (1<<SPMEN)
+ rcall DO_SPM
+ rjmp IWRITE_BUFFER3
+
+DO_SPM:
+ in_ t8, SPMCSR
+ sbrc t8, SPMEN
+ rjmp DO_SPM ; Wait for previous write to complete
+ out_ SPMCSR, t1
+ spm
+ ret
+; WD+ ( n -- ) n < 8 start watchdog timer
+.if (FLASHEND < 0x1ffff)
+ fdw PAUSE_L
+WDON_L:
+ .db NFA|3,"wd+"
+WDON:
+ cli
+ wdr
+ lds tosh, WDTCSR
+ ori tosh, (1<<WDCE)|(1<<WDE)
+ sts WDTCSR, tosh
+ andi tosl, 7
+ ori tosl, (1<<WDE)
+ sts WDTCSR, tosl
+ sei
+ jmp DROP
+
+; WD- ( -- ) stop the watchdog
+ fdw WDON_L
+WDOFF_L:
+ .db NFA|3,"wd-"
+WDOFF:
+ cli
+ wdr
+.ifdef MCUSR
+ out MCUSR, r_zero
+.else
+ out MCUCSR, r_zero
+.endif
+ ldi t0, (1<<WDCE)|(1<<WDE)
+ sts WDTCSR, t0
+ sts WDTCSR, r_zero
+ sei
+ ret
+
+; WDR ( -- ) kick the dog
+ fdw WDOFF_L
+CWD_L:
+ .db NFA|INLINE|3,"cwd"
+CWD:
+ wdr
+ ret
+
+.endif
+ fdw CWD_L
+IFLUSH_L:
+ .db NFA|6,"iflush",0
+IFLUSH:
+ sbrc FLAGS1, idirty
+ rjmp IWRITE_BUFFER
+ ret
+
+;***************************************************
+.ifdef UCSR1A
+ fdw RX1Q_L
+.else
+ fdw RX0Q_L
+.endif
+EMPTY_L:
+ .db NFA|5,"empty"
+EMPTY:
+ rcall DOLIT
+ fdw COLDLIT
+ rcall DOLIT
+ .dw dp_start
+ rcall DOLIT
+ .dw coldlitsize
+ call CMOVE
+ jmp DP_TO_RAM
+
+; Init constant registers
+INIT_012:
+ clr r_zero
+ ldi zl, 1
+ ldi zh, 2
+ movw r_one, zl
+ ret
+;*******************************************************
+ fdw EMPTY_L
+WARM_L:
+ .db NFA|4,"warm",0
+WARM_:
+; Zero memory
+ cli ; Disable interrupts
+ clr xl
+ clr xh
+ ldi yl, 25
+ ldi yh, 0
+WARM_1:
+ st x+, yh
+ subi yl, 1
+ brne WARM_1
+
+ in_ t3, SREG
+.ifdef MCUCSR
+ in_ t2, MCUCSR
+ sts MCUCSR, r_zero
+.endif
+.ifdef MCUSR
+ in_ t2, MCUSR
+ sts MCUSR, r_zero
+.endif
+ ldi xl, 0x1C ; clear ram from y register upwards
+WARM_2:
+ st x+, r_zero
+ cpi xh, 0x10 ; up to 0xfff, 4 Kbytes
+ brne WARM_2
+
+; Init empty flash buffer
+ dec ibaseh
+.ifdef RAMPZ
+ sts ibaseu, ibaseh
+.endif
+
+; Init Stack pointer
+ ldi yl, low(utibbuf-4)
+ ldi yh, high(utibbuf-4)
+
+; Init Return stack pointer
+ ldi t0, low(usbuf-1)
+ ldi t1, high(usbuf-1)
+ out spl, t0
+ out sph, t1
+
+ rcall INIT_012
+ call WDOFF
+
+; Init user pointer
+ ldi t0, low(up0)
+ ldi t1, high(up0)
+ movw upl, t0
+; Set RAMPZ for correct flash addressing
+.ifdef RAMPZ
+ ldi t0, RAMPZV
+ out_ RAMPZ, t0
+.endif
+.ifdef EIND
+ out_ EIND, r_one
+.endif
+; init warm literals
+ rcall DOLIT
+ fdw WARMLIT
+ rcall DOLIT
+ .dw cse
+ rcall DOLIT
+ .dw warmlitsize
+ call CMOVE
+; init cold data to eeprom
+ rcall DOLIT
+ .dw dp_start
+ rcall FETCH
+ rcall TRUE_
+ call EQUAL
+ call ZEROSENSE
+ breq WARM_3
+ rcall EMPTY
+WARM_3:
+; Move interrupts to boot flash section
+ out_ MCUCR, r_one ; (1<<IVCE)
+ out_ MCUCR, r_two ; (1<<IVSEL)
+; Start watchdog timer
+.if MS_TIMER == 0
+.ifdef TIMSK0
+ out_ TCCR0A, r_two ; CTC
+ ldi t0, ms_pre_tmr0
+ out_ TCCR0B, t0
+ ldi t0, ms_value_tmr0
+ out_ OCR0A, t0
+ out_ TIMSK0, r_two ; (1<<OCIE0A)
+.endif
+.ifdef TIMSK
+ ldi t0, (ms_pre_tmr0 | ( 1<<WGM01 ))
+ out_ TCCR0, t0
+ ldi t0, ms_value_tmr0
+ out_ OCR0, t0
+ ldi t0, (1<<OCIE0)
+ out_ TIMSK, t0
+.endif
+.endif
+.if MS_TIMER == 1
+; Init ms timer
+ ldi t0, 9 ; CTC, clk/1
+ out_ TCCR1B, t0
+ ldi t0, high(ms_value_tmr1)
+ out_ OCR1AH, t0
+ ldi t0, low(ms_value_tmr1)
+ out_ OCR1AL, t0
+.ifdef TIMSK
+ ldi t0, (1<<OCIE1A)
+ out_ TIMSK, t0
+.endif
+.ifdef TIMSK1
+ out_ TIMSK1, r_two ; (1<<OCIE1A)
+.endif
+.endif
+.if MS_TIMER == 2
+; Init ms timer
+.ifdef TIMSK2
+ out_ TCCR2A, r_two ; CTC
+ ldi t0, ms_pre_tmr2
+ out_ TCCR2B, t0
+ ldi t0, ms_value_tmr2
+ out_ OCR2A, t0
+ out_ TIMSK2, r_two ; t0, (1<<OCIE2A)
+.endif
+.ifdef TIMSK
+ ldi t0, (ms_pre_tmr2 | ( 1<<WGM21 ))
+ out_ TCCR2, t0
+ ldi t0, ms_value_tmr2
+ out_ OCR2, t0
+ ldi t0, (1<<OCIE2)
+ out_ TIMSK, t0
+.endif
+.endif
+
+; Init UART 0
+.ifdef UBRR0L
+ rcall DOLIT
+ .dw RX0_ISR
+ rcall DOLIT
+.ifdef URXC0addr
+ .dw URXC0addr+ivec
+.else
+ .dw URXCaddr+ivec
+.endif
+ rcall STORE
+;;; Set baud rate
+; out_ UBRR0H, r_zero
+ ldi t0, ubrr0val
+ out_ UBRR0L, t0
+ ; Enable receiver and transmitter, rx1 interrupts
+ ldi t0, (1<<RXEN0)|(1<<TXEN0)|(1<<RXCIE0)
+ out_ UCSR0B,t0
+ ; Set frame format: 8data, 1stop bit
+ ldi t0, (3<<UCSZ00)|URSEL_
+ out_ UCSR0C,t0
+.if U0FC_TYPE == 1
+ sbr FLAGS2, (1<<ixoff_tx0)
+.endif
+.if U0FC_TYPE == 2
+ sbi_ U0RTS_DDR, U0RTS_BIT
+.endif
+.endif
+; Init UART 1
+.ifdef UBRR1L
+ rcall DOLIT
+ .dw RX1_ISR
+ rcall DOLIT
+ .dw URXC1addr+ivec
+ rcall STORE
+ ; Set baud rate
+; out_ UBRR1H, r_zero
+ ldi t0, ubrr1val
+ out_ UBRR1L, t0
+ ; Enable receiver and transmitter, rx1 interrupts
+ ldi t0, (1<<RXEN1)|(1<<TXEN1)|(1<<RXCIE1)
+ out_ UCSR1B,t0
+ ; Set frame format: 8data, 1stop bit
+ ldi t0, (3<<UCSZ10)
+ out_ UCSR1C,t0
+.if U1FC_TYPE == 1
+ sbr FLAGS2, (1<<ixoff_tx1)
+.endif
+.if U1FC_TYPE == 2
+ sbi_ U1RTS_DDR, U1RTS_BIT
+.endif
+.endif
+ rcall DP_TO_RAM
+ sei
+
+ rcall RQ_EMIT
+ rcall VER
+; Turnkey ?
+ rcall TURNKEY
+ call ZEROSENSE
+ breq STARTQ2
+ call XSQUOTE
+ .db 3,"ESC"
+ call TYPE
+ rcall DOLIT
+ .dw TURNKEY_DELAY
+ rcall MS
+ call KEYQ
+ call ZEROSENSE
+ breq STARTQ1
+ call KEY
+ rcall DOLIT
+ .dw 0x1b
+ call EQUAL
+ call ZEROSENSE
+ brne STARTQ2
+STARTQ1:
+ rcall TURNKEY
+ call EXECUTE
+STARTQ2:
+ jmp ABORT
+
+.equ partlen = strlen(partstring)
+.equ datelen = strlen(DATE)
+
+ fdw WARM_L
+VER_L:
+ .db NFA|3,"ver"
+VER:
+ call XSQUOTE
+ ; 1234567890123456789012345678901234567890
+ ;.db 34,"FlashForth Atmega 5.0 ",DATE,0xd,0xa,0
+ .db partlen+datelen+16,"FlashForth 5 ",partstring," ", DATE,0xd,0xa
+ jmp TYPE
+
+; ei ( -- ) Enable interrupts
+ fdw VER_L
+EI_L:
+ .db NFA|INLINE|2,"ei",0
+ sei
+ ret
+
+; di ( -- ) Disable interrupts
+ fdw EI_L
+DI_L:
+ .db NFA|INLINE|2,"di",0
+ cli
+ ret
+;*******************************************************
+; ;i ( -- ) End definition of user interrupt routine
+ fdw DI_L
+IRQ_SEMI_L:
+ .db NFA|IMMED|2,";i",0
+IRQ_SEMI:
+ rcall DOLIT
+.ifdef EIND
+ .dw 0x940D ; jmp
+.else
+ .dw 0x940C ; jmp
+.endif
+ rcall ICOMMA
+ rcall DOLIT
+ .dw FF_ISR_EXIT
+ rcall ICOMMA
+ jmp LEFTBRACKET
+
+
+; int! ( addr n -- ) store to interrupt vector number
+ fdw IRQ_SEMI_L
+IRQ_V_L:
+ .db NFA|4,"int!",0
+IRQ_V:
+ movw zl, tosl
+ sbiw zl, 1
+ lsl zl
+.if low(ivec) == 0x80
+ ldi zh, low(ivec)
+ add zl, zh
+.endif
+ ldi zh, high(ivec)
+ poptos
+ rcall TO_XA
+ jmp STORE_RAM_2
+
+; DOLITERAL x -- compile DOLITeral x as native code
+ fdw IRQ_V_L
+LITERAL_L:
+ .db NFA|IMMED|7,"literal"
+LITERAL:
+ rcall DOLIT
+ fdw DUP
+ rcall INLINE0
+ sts litbuf0, tosl
+ sts litbuf1, tosh
+ sbr FLAGS1, (1<<fLIT)
+ call DUP
+ mov tosh, tosl
+ swap tosh
+ andi tosh, 0xf
+ andi tosl, 0xf
+ ori tosh, 0xe0
+ ori tosl, 0x80
+ rcall ICOMMA
+ mov tosl, tosh
+ swap tosh
+ andi tosh, 0xf
+ andi tosl, 0xf
+ ori tosh, 0xe0
+ ori tosl, 0x90
+ jmp ICOMMA
+
+#if 0
+LITERALruntime:
+ st -Y, tosh ; 0x939a
+ st -Y, tosl ; 0x938a
+ ldi tosl, 0x12 ; 0xe1r2 r=8 (r24)
+ ldi tosh, 0x34 ; 0xe3r4 r=9 (r25)
+#endif
+
+;*****************************************************************
+ISTORE:
+ rcall IUPDATEBUF
+ISTORE1:
+ poptos
+ ldi xl, low(ibuf)
+ ldi xh, high(ibuf)
+ lds t0, iaddrl
+ andi t0, (PAGESIZEB-1)
+ add xl, t0
+ st x+, tosl
+ st x+, tosh
+ rjmp ICSTORE_POP
+
+ fdw LITERAL_L
+TO_A_L:
+ .db NFA|2, ">a",0
+TO_A:
+ mov al, tosl
+ mov ah, tosh
+ poptos
+ ret
+
+ fdw TO_A_L
+STORE_L:
+ .db NFA|1, "!"
+STORE:
+ cpi tosh, high(PEEPROM)
+ brcc STORE1
+STORE_RAM:
+ movw zl, tosl
+ poptos
+STORE_RAM_2:
+ std Z+1, tosh
+ std Z+0, tosl
+ poptos
+ ret
+STORE1:
+ rcall LOCKEDQ
+ cpi tosh, high(OFLASH)
+ brcc ISTORE
+ESTORE:
+ call TWODUP
+ rcall ECSTORE
+ adiw tosl, 1
+ ldd t0, Y+1
+ std y+0, t0
+ rjmp ECSTORE
+
+LOCKEDQ:
+ sbrs FLAGS1, fLOCK
+ ret
+ rcall DOTS
+ call XSQUOTE
+ .db 3,"AD?"
+ call TYPE
+ rjmp STARTQ2 ; goto ABORT
+
+;***********************************************************
+IFETCH:
+ movw z, tosl
+ sub_pflash_z
+.ifdef RAMPZ
+ lds t0, ibaseu
+ cpi t0, RAMPZV
+ brne IIFETCH
+.endif
+ cpse zh, ibaseh
+ rjmp IIFETCH
+ mov t0, zl
+ andi t0, ~(PAGESIZEB-1)
+ cp t0, ibasel
+ brne IIFETCH
+ ldi xl, low(ibuf)
+ ldi xh, high(ibuf)
+ andi zl, (PAGESIZEB-1)
+ add xl, zl
+ ld tosl, x+
+ ld tosh, x+
+ ret
+IIFETCH:
+ lpm_ tosl, z+ ; Fetch from Flash directly
+ lpm_ tosh, z+
+ ret
+
+ fdw STORE_L
+A_FROM_L:
+ .db NFA|2, "a>",0
+A_FROM:
+ pushtos
+ mov tosl, al
+ mov tosh, ah
+ ret
+
+.if FLASHEND > 0x3fff
+ fdw XSTORE_L
+.else
+ fdw A_FROM_L
+.endif
+FETCH_L:
+ .db NFA|1, "@"
+FETCH:
+ cpi tosh, high(PEEPROM)
+ brcc FETCH1
+FETCH_RAM:
+ movw zl, tosl
+FETCH_RAM_2:
+ ld tosl, z+
+ ld tosh, z+
+ ret
+FETCH1:
+ cpi tosh, high(OFLASH)
+ brcc IFETCH
+EFETCH:
+ sbic eecr, eewe
+ rjmp EFETCH
+ subi tosh, high(PEEPROM)
+ out eearl, tosl
+ out eearh, tosh
+ sbi eecr, eere
+ in t0, eedr
+ inc tosl
+ out eearl, tosl
+ sbi eecr, eere
+ in tosh, eedr
+ mov tosl, t0
+ ret
+
+ICFETCH:
+ rcall IFETCH
+ clr tosh
+ ret
+
+ fdw FETCH_L
+CFETCH_L:
+ .db NFA|2, "c@",0
+CFETCH:
+ cpi tosh, high(PEEPROM)
+ brcc CFETCH1
+CFETCH_RAM:
+ movw zl, tosl
+ ld tosl, z+
+ clr tosh
+ ret
+CFETCH1:
+ cpi tosh, high(OFLASH)
+ brcc ICFETCH
+ECFETCH:
+ rcall EFETCH
+ clr tosh
+ ret
+
+ICSTORE:
+ rcall IUPDATEBUF
+ poptos
+ ldi xl, low(ibuf)
+ ldi xh, high(ibuf)
+ lds t0, iaddrl
+ andi t0, (PAGESIZEB-1)
+ add xl, t0
+ st x+, tosl
+ICSTORE_POP:
+ sbr FLAGS1, (1<<idirty)
+ rjmp CSTORE_POP
+
+ fdw CFETCH_L
+CSTORE_L:
+ .db NFA|2, "c!",0
+CSTORE:
+ cpi tosh, high(PEEPROM)
+ brcc CSTORE1
+CSTORE_RAM:
+ movw zl, tosl
+ poptos
+ st Z, tosl
+CSTORE_POP:
+ poptos
+ ret
+CSTORE1:
+ rcall LOCKEDQ
+ cpi tosh, high(OFLASH)
+ brcc ICSTORE
+ECSTORE:
+ sbic eecr, eewe
+ rjmp ECSTORE
+ subi tosh, high(PEEPROM)
+ out eearl, tosl
+ out eearh, tosh
+ poptos
+ out eedr, tosl
+ sbi eecr, eemwe
+ sbi eecr, eewe
+ rjmp CSTORE_POP
+
+;;; Disable writes to flash and eeprom
+ fdw CSTORE_L
+
+FLOCK_L:
+ .db NFA|3,"fl-"
+ sbr FLAGS1, (1<<fLOCK)
+ ret
+
+;;; Enable writes to flash and eeprom
+ fdw FLOCK_L
+FUNLOCK_L:
+ .db NFA|3,"fl+"
+ cbr FLAGS1, (1<<fLOCK)
+ ret
+
+
+
+ fdw FUNLOCK_L
+VALUE_L:
+ .db NFA|5,"value"
+VALUE:
+ rcall CREATE
+ call COMMA
+ rcall XDOES
+VALUE_DOES:
+ call DODOES
+ jmp FETCH
+
+ fdw VALUE_L
+DEFER_L:
+ .db NFA|5,"defer"
+DEFER:
+ rcall CREATE
+ call DOLIT
+ fdw ABORT
+ call COMMA
+ rcall XDOES
+DEFER_DOES:
+ call DODOES
+ jmp FEXECUTE
+
+ fdw DEFER_L
+IS_L:
+ .db NFA|IMMED|2,"is",0
+IS:
+ call TICK
+ call TWOPLUS
+ call TWOPLUS
+ rcall FETCH
+ rcall STATE_
+ call ZEROSENSE
+ breq IS1
+ rcall LITERAL
+ call DOCOMMAXT
+ fdw STORE
+ rjmp IS2
+IS1:
+ rcall STORE
+IS2:
+ ret
+
+ fdw IS_L
+TO_L:
+ .db NFA|IMMED|2,"to",0
+TO:
+ jmp IS
+
+ fdw TO_L
+TURNKEY_L:
+ .db NFA|7,"turnkey"
+TURNKEY:
+ call VALUE_DOES ; Must be call for IS to work.
+ .dw dpSTART
+
+
+;;; *******************************************************
+; PAUSE -- switch task
+ fdw TURNKEY_L
+PAUSE_L:
+ .db NFA|5,"pause"
+PAUSE:
+.if IDLE_MODE == 1
+ rcall IDLE_LOAD
+.endif
+ in_ t1, SREG
+ cli
+ wdr ; watchdog reset
+ push yh ; SP
+ push yl
+ push tosh ; TOS
+ push tosl
+ push ph ; P
+ push pl
+ movw zl, upl
+ in t0, sph
+ st -z, t0
+ in t0, spl
+ st -z, t0
+ ld xh, -z ; UP
+ ld xl, -z
+ movw upl, xl
+ ld t0, -x
+ out sph, t0
+ ld t0, -x
+ out spl, t0
+ pop pl
+ pop ph
+ pop tosl
+ pop tosh
+ pop yl
+ pop yh
+ out_ SREG, t1
+ ret
+
+
+ fdw OPERATOR_L
+ICOMMA_L:
+ .db NFA|2, "i,",0
+ICOMMA:
+ call IHERE
+ rcall STORE
+ call CELL
+ jmp IALLOT
+
+
+; IHERE ! 1 CHARS IALLOT ;
+ fdw ICOMMA_L
+ICCOMMA_L:
+ .db NFA|3,"ic,"
+ICCOMMA:
+ call IHERE
+ rcall CSTORE
+ call ONE
+ jmp IALLOT
+
+L_DOTBASE:
+ .db NFA|1," "
+DOTBASE:
+ call BASE
+ rcall FETCH
+ cpi tosl, 0x10
+ brne DOTBASE1
+ ldi tosl,'$'
+ rjmp DOTBASEEND
+DOTBASE1:
+ cpi tosl, 0xa
+ brne DOTBASE2
+ ldi tosl, '#'
+ rjmp DOTBASEEND
+DOTBASE2:
+ cpi tosl, 0x2
+ brne DOTBASE3
+ ldi tosl, '%'
+ rjmp DOTBASEEND
+DOTBASE3:
+ ldi tosl, '?'
+DOTBASEEND:
+ ret
+
+MEMQADDR_N:
+ fdw ROM_N
+ fdw EROM_N
+ fdw FRAM_N
+;*******************************************************
+umstar0:
+ push t2
+ push t3
+ ld t0, Y+
+ ld t1, Y+
+ mul tosl,t0
+ movw t4, r0 ; r0=t2, r1=t3
+ clr t6
+ clr t7
+ mul tosh, t0
+ add t5, r0
+ adc t6, r1
+ adc t7, r_zero
+ mul tosl, t1
+ add t5, r0
+ adc t6, r1
+ adc t7, r_zero
+ mul tosh, t1
+ add t6, r0
+ adc t7, r1
+ st -Y, t5
+ st -Y, t4
+ movw tosl, t6
+ pop t3
+ pop t2
+ ret
+;***********************************************************
+; unsigned 32/16 -> 16/16 division
+umslashmod0:
+ clt
+ tst tosl
+ brne umslashmodstart
+ tst tosh
+ brne umslashmodstart
+ set ; Set T flag
+ jmp WARM_
+umslashmodstart:
+ movw t4, tosl
+
+ ld t3, Y+
+ ld t6, Y+
+
+ ld tosl, Y+
+ ld tosh, Y+
+
+; unsigned 32/16 -> 16/16 division
+ ; set loop counter
+ ldi t0,$10 ;6
+
+umslashmod1:
+ ; shift left, saving high bit
+ clr t7
+ lsl tosl
+ rol tosh
+ rol t3
+ rol t6
+ rol t7
+
+ ; try subtracting divisor
+ cp t3, t4
+ cpc t6, t5
+ cpc t7,r_zero
+
+ brcs umslashmod2
+
+ ; dividend is large enough
+ ; do the subtraction for real
+ ; and set lowest bit
+ inc tosl
+ sub t3, t4
+ sbc t6, t5
+
+umslashmod2:
+ dec t0
+ brne umslashmod1 ;16=17=272
+
+umslashmod3:
+ ; put remainder on stack
+ st -Y,t6
+ st -Y,t3
+ ; Quotient is already in tos ; 6 + 272 + 4 =282 cycles
+ ret
+BASEQV:
+ fdw DECIMAL
+ fdw HEX
+ fdw BIN
+
+
+;;; *************************************
+;;; EMPTY dictionary data
+; *******************************************************************
+.equ coldlitsize=12
+COLDLIT:
+STARTV: .dw 0
+DPC: .dw OFLASH
+DPE: .dw ehere
+DPD: .dw dpdata
+LW: fdw lastword
+STAT: fdw DOTSTATUS
+;*******************************************************************
+; BOOT sector END **************************************************
+
+KERNEL_END:
diff --git a/forth/ff_uno.hex b/forth/firmware/ff_uno.hex
index b0ab0b3..b0ab0b3 100644
--- a/forth/ff_uno.hex
+++ b/forth/firmware/ff_uno.hex
diff --git a/forth/forth/2literal.fs b/forth/forth/2literal.fs
new file mode 100644
index 0000000..27cb1ef
--- /dev/null
+++ b/forth/forth/2literal.fs
@@ -0,0 +1,14 @@
+\ *******************************************************************
+\ *
+\ Filename: 2literal.txt *
+\ Date: 21.03.2013 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+
+: 2literal ( x x -- )
+ swap postpone literal postpone literal postpone ; immediate
+
diff --git a/forth/forth/avr/asm-examples.fs b/forth/forth/avr/asm-examples.fs
new file mode 100644
index 0000000..5765ee2
--- /dev/null
+++ b/forth/forth/avr/asm-examples.fs
@@ -0,0 +1,36 @@
+\ needs asm.txt
+
+-asmexamples
+marker -asmexamples
+
+\ Top of stack is always cached in R24:R25
+
+\ duplicate top of stack
+\ identical to DUP on FlashForth
+: _dup ( n -- n n )
+ [ R25 -Y st, ]
+ [ R24 -Y st, ]
+; inlined
+
+\ drop top of stack
+\ identical to DROP on FlashForth
+: _drop ( n -- )
+ [ R24 Y+ ld, ]
+ [ R25 Y+ ld, ]
+; inlined
+
+\ Load constant $1234 to top of stack
+: a-number ( -- 1234 )
+ dup \ Make space for new TOS value
+ [ R24 $34 ldi, ]
+ [ R25 $12 ldi, ]
+;
+
+\ Pop the top of stack to registers R18:R19
+\ R18 and R19 are free to use unless DO..LOOP is used
+: tos-to-r18-r19 ( n -- )
+ [ R18 R24 movw, ] \ Move TOS to R18:R19
+ drop \ load R24:R25 with new TOS
+;
+
+
diff --git a/forth/forth/avr/asm.fs b/forth/forth/avr/asm.fs
new file mode 100644
index 0000000..1ddebd0
--- /dev/null
+++ b/forth/forth/avr/asm.fs
@@ -0,0 +1,281 @@
+\ *********************************************************************
+\ Filename: asm.txt *
+\ Date: 03.02.2014 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ FlashForth assembler for Atmega chips
+-as
+marker -as
+hex
+
+\ Combine the opcode with the operand fields
+: mask! ( dest1 opcode mask -- instruction )
+ rot over invert and rot rot and or ; \ dest1&!mask src&mask or
+
+\ Fetch src and mask from addr and append to dictinary via mask
+: mask, ( dest1 addr -- )
+ 2@ swap mask! i, ;
+
+\ Create name and data fields for opcode and mask in flash
+: create,, flash create , , ram ;
+
+: Rd,Rr: ( Rd Rr opcode mask -- xxxz.xxrd.dddd.rrrr )
+ create,,
+ does> >r
+ $1f and dup $5 lshift or $20f and \ -- Rd r00000rrrr
+ swap $4 lshift $1f0 and \ -- rr 0ddddd0000
+ or r> 2@ mask! \ -- ddrr opcode mask mask!
+ dup $fc07 and $9000 =
+ if $efff and then i, ; \ if Z or Y then z=0
+
+: Rd: ( Rd opcode mask -- xxxx.xxxd.dddd.xxxx )
+ create,,
+ does> >r
+ $4 lshift $1f0 and \ -- 0ddddd0000
+ r> mask, ;
+
+ \ Operands Rd,constant 8bit
+: Rd,k: ( Rd k8 opcode mask -- xxxx.kkkk.dddd.kkkk )
+ create,,
+ does> >r
+ $ff and dup $4 lshift or $f0f and \ -- Rd kkkk0000kkkk
+ swap $4 lshift $f0 and \ -- kk dddd0000
+ or r> mask, ; \ kkdd opcode mask mask! to flash
+
+\ Operands Rd,Rr,constant 6bit
+: Rd,Rr+q: ( Rd Rr k6 opcode mask -- xxkx.kkxd.dddd.rkkk )
+ create,,
+ does> >r
+ $3f and dup $7 lshift \ -- Rd Rr k6 xkkkkkkxxxxxxx
+ dup $1000 and $1 lshift or or $2c07 and \ -- Rd Rr kxkkxxxxxxxkkk
+ rot $4 lshift $1f0 and \ -- Rr kk ddddd0000
+ or swap 8 and \ -- kkdd rxxx
+ or r> mask, ; \ kkddrr opcode mask mask! to flash
+
+
+\ Operands Rw pair,constant 6bit
+: Rw,k: ( Rw k6 opcode mask -- xxxx.xxxx.kkww.kkkk )
+ create,,
+ does> >r
+ $3f and dup $2 lshift $c0 and \ -- Rw k6 kk000000
+ swap $f and or \ -- Rw kk00kkkk
+ swap $4 lshift $30 and \ -- kk ww0000
+ or r> mask, ; \ kkww opcode mask mask! to flash
+
+\ Operands P-port,bit
+: P,b: ( P b opcode mask -- xxxx.xxxx.PPPP.Pbbb )
+ create,,
+ does> >r
+ $7 and swap $3 lshift \ -- 0bbb PPPPP000
+ or r> mask, ; \ PPbb opcode mask mask! to flash
+
+\ Operands Rd,P-port
+: Rd,P: ( Rd P opcode mask -- xxxx.xPPd.dddd.PPPP )
+ create,,
+ does> >r
+ $3f and dup $5 lshift or $60f and \ -- Rd PP00000PPPP
+ swap $4 lshift $1f0 and \ -- PP 00ddddd0000
+ or r> mask, ; \ ddPP opcode mask mask! to flash
+
+
+\ Operand k16 k6
+: k22: ( k16 k6 opcode mask -- k16 xxxx.xxxk.kkkk.xxxk )
+ create,,
+ does> >r
+ dup $1 and swap $3 lshift \ -- 000k kkkkkk000
+ or r> mask, i, ; \ k16 kk opcode mask mask! to flash
+
+\ Opcode only to flash
+: op: ( opcode -- )
+ flash create , ram does> @ i, ;
+
+
+0100 ff00 Rd,Rr: movw_
+: movw, 1 rshift swap \ R0:1,R2:3,R4:5,..R30:31
+ 1 rshift swap \ 0 2 movw, R0:1<--R2:3
+ movw_ ; \ Rd Rr --
+9c00 fc00 Rd,Rr: mul, \ Rd Rr --
+0200 ff00 Rd,Rr: muls, \ Rd Rr --
+0300 ff88 Rd,Rr: mulsu, \ Rd Rr --
+0308 ff88 Rd,Rr: fmul, \ Rd Rr --
+0380 ff88 Rd,Rr: fmuls, \ Rd Rr --
+0388 ff88 Rd,Rr: fmulsu, \ Rd Rr --
+0400 fc00 Rd,Rr: cpc, \ Rd Rr --
+0800 fc00 Rd,Rr: sbc, \ Rd Rr --
+0c00 fc00 Rd,Rr: add, \ Rd Rr --
+1000 fc00 Rd,Rr: cpse, \ Rd Rr --
+1400 fc00 Rd,Rr: cp, \ Rd Rr --
+1800 fc00 Rd,Rr: sub, \ Rd Rr --
+1c00 fc00 Rd,Rr: adc, \ Rd Rr --
+2000 fc00 Rd,Rr: and, \ Rd Rr --
+2400 fc00 Rd,Rr: eor, \ Rd Rr --
+2800 fc00 Rd,Rr: or, \ Rd Rr --
+2c00 fc00 Rd,Rr: mov, \ Rd Rr --
+
+3000 f000 Rd,k: cpi, \ Rd k --
+4000 f000 Rd,k: sbci, \ Rd k --
+5000 f000 Rd,k: subi, \ Rd k --
+6000 f000 Rd,k: ori, \ Rd k --
+: sbr, ori, ; \ Rd k --
+7000 f000 Rd,k: andi, \ Rd k --
+: cbr, invert andi, ;
+e000 f000 Rd,k: ldi,
+
+
+8000 d200 Rd,Rr+q: ldd, ( Rd Rr q -- ) \ Rr={Z+,Y+}, 2 Y+ 3F ldd,
+8200 d200 Rd,Rr+q: std, ( Rr Rd q -- ) \ Rd={Z+,Y+}, Y+ 3F 2 std,
+
+9000 fe00 Rd,Rr: ld, ( Rd Rr -- ) \ Rr={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z}
+9000 fe0f Rd: lds_
+: lds, swap lds_ i, ; \ Rd k16 -- )
+
+9004 fe0f Rd,Rr: lpm, ( Rd Rr -- ) \ Rr={Z,Z+}, 2 Z+ lpm,
+9006 fe0e Rd,Rr: elpm, ( Rd Rr -- ) \ Rr={Z,Z+}
+9200 fe00 Rd,Rr: st, ( Rr Rd -- ) \ Rd={Z+,-Z,Y+,-Y,X+,-X,X,Y,Z}
+
+9200 fe0f Rd: sts_
+: sts, sts_ i, ; ( k16 Rd -- ) \ FFFF 2 sts, adr(FFFF)<--R2
+
+: lsl, dup add, ; \ Rd --
+: rol, dup adc, ; \ Rd --
+: tst, dup and, ; \ Rd --
+: clr, dup eor, ; \ Rd --
+: ser, $ff ldi, ; \ Rd --
+
+900f fe0f Rd: pop, \ Rd --
+920f fe0f Rd: push, \ Rd --
+9400 fe0f Rd: com, \ Rd --
+9401 fe0f Rd: neg, \ Rd --
+9402 fe0f Rd: swap, \ Rd --
+9403 fe0f Rd: inc, \ Rd --
+9405 fe0f Rd: asr, \ Rd --
+9406 fe0f Rd: lsr, \ Rd --
+9407 fe0f Rd: ror, \ Rd --
+9408 ff8f Rd: bset, \ Rd --
+9488 ff8f Rd: bclr, \ Rd --
+940a fe0f Rd: dec, \ Rd --
+
+0000 op: nop, \ --
+9508 op: ret, \ --
+9518 op: reti, \ --
+9588 op: sleep, \ --
+9598 op: break, \ --
+95a8 op: wdr, \ --
+9409 op: ijmp, \ --
+9419 op: eijmp, \ --
+9509 op: icall, \ --
+9519 op: eicall, \ --
+
+9488 op: clc, \ --
+94d8 op: clh, \ --
+94d8 op: cli, \ --
+94a8 op: cln, \ --
+94c8 op: cls, \ --
+94e8 op: clt, \ --
+94b8 op: clv, \ --
+9498 op: clz, \ --
+9408 op: sec, \ --
+9458 op: seh, \ --
+9478 op: sei, \ --
+9428 op: sen, \ --
+9448 op: ses, \ --
+9468 op: set, \ --
+9438 op: sev, \ --
+9418 op: sez, \ --
+
+9600 ff00 Rw,k: adiw, ( Rw k6 -- ) \ 3 3F adiw, ZLH=ZLH+#3F
+9700 ff00 Rw,k: sbiw,
+9800 ff00 P,b: cbi, \ P b --
+9900 ff00 P,b: sbic, \ P b --
+9a00 ff00 P,b: sbi, \ P b --
+9b00 ff00 P,b: sbis, \ P b --
+
+b000 f800 Rd,P: inn, \ Rd P --
+b800 f800 Rd,P: out, \ Rr P --
+
+f800 fe08 Rd,Rr: bld, \ Rd b --
+fa00 fe08 Rd,Rr: bst, \ Rd b --
+fc00 fe08 Rd,Rr: sbrc, \ Rd b --
+fe00 fe08 Rd,Rr: sbrs, \ Rd b --
+
+940c fe0e k22: jmp, ( k16 k6 -- ) \ k6=0 for 16b addr
+940e fe0e k22: call, ( k16 k6 -- ) \ k6=0 for 16b addr
+: rjmp, c000 f000 mask! i, ; ( k12 -- )
+: rcall, d000 f000 mask! i, ; ( k12 -- )
+
+
+f008 constant cs, \ if/until carry set
+f008 constant lo, \ if/until lower
+f009 constant eq, \ if/until zero
+f00a constant mi, \ if/until negative
+f00b constant vs, \ if/until no overflow
+f00c constant lt, \ if/until less than
+f00d constant hs, \ if/until half carry set
+f00e constant ts, \ if/until T flag set
+f00f constant ie, \ if/until interrupt enabled
+
+: not, 0400 xor ; \ Invert the condition code
+
+: if, ( cc -- addr) i, [ ' if #8 + pfl - zfl d2/ jmp, ] ;
+: else, postpone else ;
+: then, postpone then ;
+: begin, postpone begin ;
+: until, ( addr cc -- ) i, postpone again ;
+: again, ( addr -- ) postpone again ;
+
+$00 constant Z
+$01 constant Z+
+$02 constant -Z
+$08 constant Y
+$09 constant Y+
+$0a constant -Y
+$0c constant X
+$0d constant X+
+$0e constant -X
+
+00 constant R0
+01 constant R1
+02 constant R2
+03 constant R3
+04 constant R4
+05 constant R5
+06 constant R6
+07 constant R7
+08 constant R8
+09 constant R9
+0a constant R10
+0b constant R11
+0c constant R12
+0d constant R13
+0e constant R14
+0f constant R15
+10 constant R16
+11 constant R17
+12 constant R18
+13 constant R19
+14 constant R20
+15 constant R21
+16 constant R22
+17 constant R23
+18 constant R24
+19 constant R25
+1a constant R26
+1b constant R27
+1c constant R28
+1d constant R29
+1e constant R30
+1f constant R31
+1a constant XL
+1b constant XH
+1c constant YL
+1d constant YH
+1e constant ZL
+1f constant ZH
+01 constant XH:XL \ XH:XL 3F adiw, sbiw,
+02 constant YH:YL
+03 constant ZH:ZL
diff --git a/forth/forth/avr/asm2.fs b/forth/forth/avr/asm2.fs
new file mode 100644
index 0000000..0f90355
--- /dev/null
+++ b/forth/forth/avr/asm2.fs
@@ -0,0 +1,192 @@
+\ *********************************************************************
+\ Filename: asm2.txt *
+\ Date: 16.10.2017 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Table driven assembler for Atmega chips
+-as
+marker -as
+hex
+: ar: ( n "name" -- ) create does> swap 2* 2* + ;
+: ri! ( index n -- ) here swap - dup c@ rot 4 lshift or swap c! ;
+
+flash ar: rules
+\ d mask.shift, r mask.shift
+[ 000.0 , 000.0 , ] \ 00 xxxx.xxxx.xxxx.xxxx ret sleep wdr
+[ 1f0.4 , 00f.0 , ] \ 01 xxxx.xxxd.dddd.rrrr ld x+ -x y+ -y z+ -z
+[ 1f0.4 , 00f.0 , ] \ 02 xxxx.xxxd.dddd.rrrr st x+ -x y+ -y z+ -z
+[ 030.4 , 0cf.2 , ] \ 03 xxxx.xxxx.kkpp.kkkk adiw sbiw
+[ 0f8.3 , 007.0 , ] \ 04 xxxx.xxxx.aaaa.abbb cbi sbi sbic sbis
+[ 1f0.4 , 60f.5 , ] \ 05 xxxx.xaad.dddd.aaaa in
+[ 1f0.4 , 60f.5 , ] \ 06 xxxx.xaad.dddd.aaaa out
+[ 1f0.4 , 000.0 , ] \ 07 xxxx.xxxd.dddd.xxxx lds
+[ 1f0.4 , 000.0 , ] \ 08 xxxx.xxxd.dddd.xxxx sts
+[ 1f0.4 , 000.0 , ] \ 09 xxxx.xxxd.dddd.xxxx pop push com neg
+ \ swap inc asr lsr ror dec
+[ 0f0.4 , f0f.4 , ] \ 0a xxxx.kkkk.dddd.kkkk cpi sbci subi ori andi ldi
+[ 0f0.4 , 00f.0 , ] \ 0b xxxx.xxxx.dddd.rrrr movw
+[ 1f0.4 , 20f.5 , ] \ 0c xxxx.xxrd.dddd.rrrr cpc cp sbc sub add adc cpse
+ \ and eor or mov mul
+ \ ( rol lsl tst clr ser )
+[ 1f0.4 , 007.0 , \ 0d xxxx.xxxd.dddd.0rrr bld bst sbrc sbrs
+\ 000.0 , 000.0 , \ 0f if then begin until again
+
+\ 126 opcodes opcode name ruleindex namelen
+flash create opcodes
+[ 9508 , ," ret" 0 4 ri! ]
+[ 9588 , ," sleep" 0 6 ri! ]
+[ 0000 , ," nop" 0 4 ri! ]
+[ 9000 , ," ld" 1 4 ri! ]
+[ 9200 , ," st" 2 4 ri! ]
+[ 9600 , ," adiw" 3 6 ri! ]
+[ 9700 , ," sbiw" 3 6 ri! ]
+[ 9800 , ," cbi" 4 4 ri! ]
+[ 9900 , ," sbic" 4 6 ri! ]
+[ 9a00 , ," sbi" 4 4 ri! ]
+[ 9b00 , ," sbis" 4 6 ri! ]
+[ b000 , ," in" 5 4 ri! ]
+[ b800 , ," out" 6 4 ri! ]
+[ 9000 , ," lds" 7 4 ri! ]
+[ 9200 , ," sts" 8 4 ri! ]
+[ 900f , ," pop" 9 4 ri! ]
+[ 920f , ," push" 9 6 ri! ]
+[ 9400 , ," com" 9 4 ri! ]
+[ 9401 , ," neq" 9 4 ri! ]
+[ 9402 , ," swap" 9 6 ri! ]
+[ 9403 , ," inc" 9 4 ri! ]
+[ 9405 , ," asr" 9 4 ri! ]
+[ 9406 , ," lsr" 9 4 ri! ]
+[ 9407 , ," ror" 9 4 ri! ]
+[ 940a , ," dec" 9 4 ri! ]
+[ 3000 , ," cpi" a 4 ri! ]
+[ 4000 , ," sbci" a 6 ri! ]
+[ 5000 , ," subi" a 6 ri! ]
+[ 6000 , ," ori" a 4 ri! ]
+[ 7000 , ," andi" a 6 ri! ]
+[ e000 , ," ldi" a 4 ri! ]
+[ 0100 , ," movw" b 6 ri! ]
+[ 9c00 , ," mul" c 4 ri! ]
+[ 0400 , ," cpc" c 4 ri! ]
+[ 0800 , ," sbc" c 4 ri! ]
+[ 0c00 , ," add" c 4 ri! ]
+[ 1000 , ," cpse" c 6 ri! ]
+[ 1400 , ," cp" c 4 ri! ]
+[ 1800 , ," sub" c 4 ri! ]
+[ 1c00 , ," adc" c 4 ri! ]
+[ 2000 , ," and" c 4 ri! ]
+[ 2400 , ," eor" c 4 ri! ]
+[ 2800 , ," or" c 4 ri! ]
+[ 2c00 , ," mov" c 4 ri! ]
+[ f800 , ," bld" d 4 ri! ]
+[ fa00 , ," bst" d 4 ri! ]
+[ fc00 , ," sbrc" d 6 ri! ]
+[ fe00 , ," sbrs" d 6 ri! ]
+[ 0000 , ," if" f 4 ri! ]
+[ 0002 , ," then" f 6 ri! ]
+[ 0004 , ," begin" f 6 ri! ]
+[ 0006 , ," until" f 6 ri! ]
+[ 0008 , ," again" f 6 ri! ]
+[ ffff ,
+ram
+
+flash create sy1
+hex
+[ 1 , ," z+" 2 , ," -z" ]
+[ 9 , ," y+" a , ," -y" ]
+[ d , ," x+" e , ," -x" ]
+[ $ffff ,
+ram
+
+flash create sy2
+[ f400 , ," cs" ]
+[ f400 , ," lo" ]
+[ f401 , ," eq" ]
+[ f402 , ," mi" ]
+[ f403 , ," vs" ]
+[ f404 , ," lt" ]
+[ f405 , ," hs" ]
+[ f406 , ," ts" ]
+[ f407 , ," ie" ]
+[ f000 , ," cc" ]
+[ f000 , ," sh" ]
+[ f001 , ," ne" ]
+[ f002 , ," pl" ]
+[ f003 , ," vc" ]
+[ f004 , ," ge" ]
+[ f005 , ," hc" ]
+[ f006 , ," tc" ]
+[ f007 , ," id" ]
+[ ffff ,
+ram
+hex
+\
+: dsm ( index -- shift mask ) @ dup f and swap 4 rshift ;
+: msi ( code index -- code) rules dsm >r lshift r> and ;
+: split ( code index -- code )
+ rules 2+ dsm >r over swap lshift fff0 and or r> and ;
+
+: asm ( opc index d/b r/k/a/b -- asm )
+ rot >r swap
+ r@ msi \ dest shifted and masked
+ swap r> split \ resource splitted and masked
+ or or ; \ opc n2 n1 combined
+
+: sy? ( word table -- address )
+ begin
+ @+ 1+
+ while
+ 2dup n=
+ if c@+ 7 and + aligned
+ else nip 2- exit
+ then
+ repeat
+ drop c@+ type ." ?" abort ;
+
+: op? ( word table -- opc index ) sy? dup @ swap 2+ c@ 4 rshift ;
+
+: bw bl word ;
+: N# number? 1- 0= abort" ?" ;
+: n# bw N# ;
+: d# bw sy1 sy? @ ;
+: r# bw dup 1+ dup c@ 4f - swap c! N# 1f and ;
+: c# bw sy2 sy? @ ;
+
+: as1 2+ - 2/ 3 lshift 3f8 and ;
+:noname ; \ again
+:noname c# >r ihere as1 r> or i, ; \ until
+:noname ihere ; \ begin
+:noname ihere over as1 over @ or swap ! ; \ then
+:noname c# i, ihere 2- ; \ if
+flash create ask , , , , , ram
+
+:noname r# 2/ r# 2/ asm ; \ movw
+:noname r# n# asm ;
+:noname r# false asm ; \ one param
+:noname n# >r r# false asm i, r> ; \ sts
+:noname r# n# >r false asm i, r> ; \ lds
+:noname n# r# swap asm ; \ out
+:noname r# n# asm ; \ in
+:noname n# n# asm ; \ sbic 0-31, 0-7
+:noname r# 2/ n# asm ; \ adiw sbiw r24 r26 r28 r30
+:noname d# r# swap asm ; \ st
+:noname r# d# asm ; \ ld
+:noname drop ; \ no params
+flash create ass , , , , , , , , , , , , ram
+
+: as: ( -- )
+ bw opcodes op?
+ dup f - 0=
+ if drop ask + @ex \ handle flow control
+ else
+ dup $c <
+ if dup 2* ass + @ex
+ else r# r# asm \ two params
+ then i,
+ then
+; immediate
+
diff --git a/forth/forth/avr/asm2test.fs b/forth/forth/avr/asm2test.fs
new file mode 100644
index 0000000..976420b
--- /dev/null
+++ b/forth/forth/avr/asm2test.fs
@@ -0,0 +1,32 @@
+
+-asmtest
+marker -asmtest
+
+: qq
+ as: if eq
+ as: nop
+ as: then
+;
+
+: ww
+ as: begin
+ as: nop
+ as: until eq
+;
+\ square root of unsigned cell.
+: sqrt ( u --- u )
+ as: adiw r24 1
+ as: ldi r16 $00
+ as: ldi r17 $80
+ as: begin
+ as: eor r16 r17
+ as: mul r16 r16
+ as: cp r0 r24
+ as: cpc r1 r25
+ as: if sh
+ as: eor r16 r17
+ as: then
+ as: lsr r17
+ as: until eq
+ as: movw r24 r16
+; \ No newline at end of file
diff --git a/forth/forth/avr/asmtest.fs b/forth/forth/avr/asmtest.fs
new file mode 100644
index 0000000..7ec44ef
--- /dev/null
+++ b/forth/forth/avr/asmtest.fs
@@ -0,0 +1,59 @@
+\ Some tests for the Atmega assembler
+\ needs the assembler and see
+-asmtest
+marker -asmtest
+: asmtest ( n1 n2 -- )
+ = if ." OK" else ." ERROR" then cr ;
+
+#30 #28 mov,
+flash here ram 2- @ $2fec asmtest \ Rd,Rr:
+
+#17 #15 ldi,
+flash here ram 2- @ $e01f asmtest \ Rd,k:
+
+#17 $1234 lds,
+flash here ram 4 - @+ swap @ u. u. \ Rd: 9110 1234
+
+$09 constant Y+
+9 Y+ $31 ldd,
+ flash here ram 2 - @ $a899 asmtest
+
+$01 constant Z+
+9 Z+ $31 ldd,
+ flash here ram 2 - @ $a891 asmtest
+
+\ Leave true flag if zero flag is true
+: testif0
+ [ sez, ] \ Set zero flag
+ [ eq, if, ] \ if zero
+ true
+ [ else, ] \ else not zero
+ false
+ [ then, ]
+;
+testif0 .
+
+\ Leave true flag if zero flag is false
+: testif1
+ [ clz, ] \ Clear zero flag
+ [ eq, not, if, ] \ if not zero
+ true
+ [ else, ] \ else zero
+ false
+ [ then, ]
+;
+testif1 .
+
+\ Increment 24 bit value until result is zero
+: testuntil
+ [ #16 #0 ldi, ]
+ [ #17 #0 ldi, ]
+ [ #18 #1 ldi, ]
+ [ begin, ]
+ [ #16 #6 add, ] \ R6 contains 1
+ [ #17 #5 adc, ] \ R5 contains 0
+ [ #18 #5 adc, ]
+ [ eq, until, ] \ until R18 is zero
+;
+testuntil
+
diff --git a/forth/forth/avr/bit-test.fs b/forth/forth/avr/bit-test.fs
new file mode 100644
index 0000000..cdfdcea
--- /dev/null
+++ b/forth/forth/avr/bit-test.fs
@@ -0,0 +1,58 @@
+\ *********************************************************************
+\ *
+\ Filename: bit-test.txt *
+\ Date: 06.01.2015 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Test words for manipulating bits in ram and in IO registers
+\ Needs bit.txt
+-bittest
+marker -bittest
+
+\ BIT addressable IO register
+\ $20 - $3f
+$22 constant porta
+
+\ IN OUT addressable IO register
+$4a constant gpior1
+
+\ LDS STS addressable IO register
+$124 constant tcnt5l
+
+porta 2 bit0: porta2off
+porta 2 bit1: porta2on
+porta 2 bit?: porta2?
+
+gpior1 0 bit0: gpio0off
+gpior1 0 bit1: gpio0on
+gpior1 0 bit?: gpio0?
+
+tcnt5l 7 bit0: tcnt5l7off
+tcnt5l 7 bit1: tcnt5l7on
+tcnt5l 7 bit?: tcnt5l7?
+
+-1 porta c!
+porta2off porta c@ . porta2? .
+porta2on porta c@ . porta2? .
+0 porta c!
+porta2on porta c@ . porta2? .
+porta2off porta c@ . porta2? .
+
+-1 gpior1 c!
+gpio0off gpior1 c@ . gpio0? .
+gpio0on gpior1 c@ . gpio0? .
+0 gpior1 c!
+gpio0off gpior1 c@ . gpio0? .
+gpio0on gpior1 c@ . gpio0? .
+0 gpior1 c!
+-1 tcnt5l c!
+tcnt5l7off tcnt5l c@ . tcnt5l7? .
+tcnt5l7on tcnt5l c@ . tcnt5l7? .
+0 tcnt5l c!
+tcnt5l7on tcnt5l c@ . tcnt5l7? .
+tcnt5l7off tcnt5l c@ . tcnt5l7? .
diff --git a/forth/forth/avr/bit.fs b/forth/forth/avr/bit.fs
new file mode 100644
index 0000000..c61e48e
--- /dev/null
+++ b/forth/forth/avr/bit.fs
@@ -0,0 +1,77 @@
+\ *********************************************************************
+\ *
+\ Filename: bit.txt *
+\ Date: 06.01.2015 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Words for manipulating bits in ram.
+\ Memory mapped addresses of I/O ports must be used.
+\ CBI SBI SBIS instructions will be generated for adresses $20-$3f
+\ IN and OUT instruction will be used for addresses $40 to $5f
+\ LDS and STS instructions will be used for addresses over $60
+\ Bit has value 0..7
+
+-bit
+marker -bit
+: (bio) ( c-addr -- in/out-addr ) $20 - dup $5 lshift or $60f and ;
+: (bit) ( c-addr bit flag "name" -- )
+ : >r
+ over $40 < if
+ swap $20 - 3 lshift or
+ r>
+ if $9a00 \ sbi io-addr, bit
+ else $9800 \ cbi io-addr, bit
+ then or i,
+ else
+ over $60 <
+ if over (bio) $b100 or \ in r16 io-addr
+ else $9100 i, over \ lds r16 c-addr
+ then i,
+ 1 swap lshift
+ r>
+ if $6000 >r
+ else $7000 >r invert $ff and
+ then dup 4 lshift or $f0f and r> or i, \ andi/ori r16, mask
+ dup $60 <
+ if (bio) $b900 or \ out io-addr r16
+ else $9300 i, \ sts c-addr r16
+ then i,
+ then
+ $9508 i, \ return
+ postpone [
+;
+
+\ Define a word that clears a bit in ram
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit0: false (bit) ;
+
+\ Define a word that sets a bit in ram
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit1: true (bit) ;
+
+\ Define a word that leaves a true flag if a bit in ram is one
+\ and a false flag if a bit is zero.
+\ The defined word can be inlined
+( c-addr bit "name" -- )
+: bit?:
+ :
+ $939a i, $938a i, $ef8f i, $ef9f i, \ true
+ over $40 < if
+ swap $20 - 3 lshift or $9b00 or i, \ sbis io-addr, bit
+ else
+ over $60 <
+ if swap (bio) $b100 or \ in r16 io-addr
+ else $9100 i, swap \ lds r16 c-addr
+ then i, $ff00 or i, \ sbrs r16, bit
+ then
+ $9601 i, \ 1+
+ $9508 i, \ return
+ postpone [
+;
diff --git a/forth/forth/avr/doloop.fs b/forth/forth/avr/doloop.fs
new file mode 100644
index 0000000..7b7eab2
--- /dev/null
+++ b/forth/forth/avr/doloop.fs
@@ -0,0 +1,92 @@
+\ *********************************************************************
+\ *
+\ Filename: doloop.txt *
+\ Date: 11.04.2017 *
+\ File Version: 5.0 *
+\ MCU: Atmega (not 256) *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ do loop for Atmega32,64,128 (not 256)
+-doloop
+marker -doloop
+
+: compileonly $10 shb ;
+
+#20 constant ind inlined \ R18:R19 are unused by the kernel
+
+: (do) ( limit index -- R: leave oldindex xfaxtor )
+ r>
+ dup >a xa> @ >r \ R: leave
+ ind @ >r \ R: leave oldindex
+ swap $8000 swap - dup >r \ R: leave oldindex xfactor
+ + ind !
+ a> 1+ >r
+; compileonly
+
+: (?do) ( limit index -- R: leave oldindex xfactor )
+ 2dup xor
+ if
+ [ ' (do) ] again \ branch to (do)
+ then
+ r> xa> @ >r 2drop
+; compileonly
+
+: (+loop) ( n -- )
+ [ $0f48 i, ] \ add r20, tosl
+ [ $1f59 i, ] \ add r21, tosh
+ inline drop
+; compileonly
+
+: unloop
+ r>
+ rdrop r> ind ! rdrop
+ >r
+; compileonly
+
+: do
+ postpone (do)
+ postpone begin
+ flash 2 allot ram \ leave address
+ postpone begin
+; immediate compileonly
+
+: ?do
+ postpone (?do)
+ postpone begin
+ flash 2 allot ram \ leave address
+ postpone begin
+; immediate compileonly
+
+: leave
+ rdrop rdrop r> ind !
+; compileonly
+
+: i
+ ind @ rp@ 3 + @ >< -
+; compileonly
+
+: j
+ rp@ 5 + @ >< rp@ 9 + @ >< -
+; compileonly
+
+
+: loop
+ $0d46 i, $1d55 i, \ add 1 to r20:r21
+\ postpone (loop)
+ $f00b i, \ bra +2 if overflow
+ postpone again
+ postpone unloop
+ flash here >xa swap ! ram
+; immediate compileonly
+
+: +loop
+ postpone (+loop)
+ $f00b i, \ bra +2 if overflow
+ postpone again
+ postpone unloop
+ flash here >xa swap ! ram
+; immediate compileonly
+
diff --git a/forth/forth/avr/i2c-base-avr.fs b/forth/forth/avr/i2c-base-avr.fs
new file mode 100644
index 0000000..50f9abc
--- /dev/null
+++ b/forth/forth/avr/i2c-base-avr.fs
@@ -0,0 +1,99 @@
+\ i2c-base-avr.txt
+\ Low-level words for TWI/I2C on Atmega328P.
+\
+\ Modelled on i2c-twi.frt from amforth,
+\ i2c_base.txt for FlashForth on PIC18
+\ and the Atmel datasheet, of course.
+\ Peter J. 2014-10-27
+\ Watchdog added Mikael Nordman @ 12.5.2017
+
+-i2c-base
+marker -i2c-base
+hex ram
+
+\ Two-Wire-Interface Registers
+$b8 constant TWBR
+$b9 constant TWSR
+$bb constant TWDR
+$bc constant TWCR
+
+\ Bits in the Control Register
+%10000000 constant mTWINT
+%01000000 constant mTWEA
+%00100000 constant mTWSTA
+%00010000 constant mTWSTO
+%00001000 constant mTWWC
+%00000100 constant mTWEN
+%00000001 constant mTWIE
+
+: i2c.init ( -- ) \ Set clock frequency to 100kHz
+ %11 TWSR mclr \ prescale value = 1
+ [ Fcy #100 / #16 - 2/ ] literal TWBR c!
+ mTWEN TWCR mset
+;
+
+: i2c.wait ( -- ) \ Wait for operation to complete
+ \ When TWI operations are done, the hardware sets
+ \ the TWINT interrupt flag, which we will poll.
+ \ Watchdog timeout
+ 7 wd+ begin TWCR c@ mTWINT and until wd-
+;
+
+: i2c.start ( -- ) \ Send start condition
+ [ mTWINT mTWEN or mTWSTA or ] literal TWCR c!
+ i2c.wait
+;
+
+: i2c.rsen ( -- ) \ Send repeated start condition
+ i2c.start \ AVR doesn't distinguish
+;
+
+: i2c.stop ( -- ) \ Send stop condition
+ [ mTWINT mTWEN or mTWSTO or ] literal TWCR c!
+;
+
+\ Write one byte to bus, returning 0 if ACK was received, -1 otherwise.
+: i2c.c! ( c -- f )
+ i2c.wait \ Must have TWINT high to write data
+ TWDR c!
+ [ mTWINT mTWEN or ] literal TWCR c!
+ i2c.wait
+ \ Test for arrival of an ACK depending on what was sent.
+ TWSR c@ $f8 and $18 = if 0 exit then \ SLA+W
+ TWSR c@ $f8 and $28 = if 0 exit then \ data byte
+ TWSR c@ $f8 and $40 = if 0 exit then \ SLA+R
+ -1 \ Something other than an ACK resulted
+;
+
+\ Read one byte and ack for another.
+: i2c.c@.ack ( -- c )
+ [ mTWINT mTWEN or mTWEA or ] literal TWCR c!
+ i2c.wait
+ TWDR c@
+;
+
+\ Read one last byte.
+: i2c.c@.nack ( -- c )
+ [ mTWINT mTWEN or ] literal TWCR c!
+ i2c.wait
+ TWDR c@
+;
+
+\ Address slave for writing, leaving true if slave ready.
+: i2c.addr.write ( 7-bit-addr -- )
+ 2* \ Build full byte with write-bit as 0
+ i2c.start i2c.c! if false else true then
+;
+
+\ Address slave for reading, leaving true if slave ready.
+: i2c.addr.read ( 7-bit-addr -- )
+ 2* 1+ \ Build full byte with read-bit as 1
+ i2c.start i2c.c! if false else true then
+;
+
+\ Detect presence of device, leaving true if slave responded.
+\ If the slave ACKs the read request, fetch one byte only.
+: i2c.ping? ( 7-bit-addr -- f )
+ 2* 1+ \ Build full byte with read-bit as 1
+ i2c.start i2c.c! 0= if i2c.c@.nack drop true else false then
+;
diff --git a/forth/forth/avr/i2c-ds1307.fs b/forth/forth/avr/i2c-ds1307.fs
new file mode 100644
index 0000000..20aa069
--- /dev/null
+++ b/forth/forth/avr/i2c-ds1307.fs
@@ -0,0 +1,72 @@
+\ *********************************************************************
+\ *
+\ Filename: i2c-ds1307.txt *
+\ Date: 12.05.2016 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+
+\ ********************************
+\ DS1307 RTC i2c words
+\ ********************************
+-ds1307
+marker -ds1307
+
+\ i2c device address
+$68 constant addr-ds1307
+
+: i2c! i2c.c! drop ;
+
+: ds1307.addr! ( c -- ) \ Set ds1307 register address
+ i2c.init addr-ds1307 i2c.addr.write drop
+ i2c! i2c.stop ;
+
+: time! ( c c c c c c c -- )
+ i2c.init addr-ds1307 i2c.addr.write drop
+ 0 i2c! i2c! i2c! i2c! i2c! i2c! i2c! i2c!
+ i2c.stop
+;
+
+: time@ ( -- c c c c c c c )
+ 0 ds1307.addr!
+ addr-ds1307 i2c.addr.read drop
+ i2c.c@.ack i2c.c@.ack i2c.c@.ack
+ i2c.c@.ack i2c.c@.ack i2c.c@.ack i2c.c@.nack
+ i2c.stop
+;
+
+: bin>bcd ( c -- c )
+ #10 u/mod #4 lshift or
+;
+: set-time ( year month date day hour min sec -- )
+ >r >r >r >r >r >r
+ $00 swap \ 11 = 4.096 KHz output 00 = no output
+ bin>bcd \ Year 0-99
+ r> bin>bcd \ Month
+ r> bin>bcd \ Date
+ r> \ Day 1-7
+ r> bin>bcd \ Hours
+ r> bin>bcd \ Minutes
+ r> bin>bcd \ Seconds
+ time!
+;
+
+: i2c.ds1307.c@ ( addr -- c )
+ ds1307.addr! addr-ds1307 i2c.addr.read drop i2c.c@.nack i2c.stop
+;
+: i2c.ds1307.c! ( c addr -- )
+ i2c.init addr-ds1307 i2c.addr.write drop i2c! i2c! i2c.stop
+;
+
+
+: i2c.ds1307.n@ ( n addr -- )
+ ds1307.addr!
+ addr-ds1307 i2c.addr.read drop
+ for i2c.c@.ack next
+ i2c.c@.nack i2c.stop
+;
+
diff --git a/forth/forth/avr/irqAtmega128.fs b/forth/forth/avr/irqAtmega128.fs
new file mode 100644
index 0000000..43e20f9
--- /dev/null
+++ b/forth/forth/avr/irqAtmega128.fs
@@ -0,0 +1,45 @@
+\ *********************************************************************
+\ Interrupts example for FlashForth *
+\ Filename: irq.txt *
+\ Date: 04.10.2013 *
+\ FF Version: 5.0 *
+\ MCU: Atmega128 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Disable interrupt before removing the interrupt code
+irqOvf3Dis
+-irqOvf3
+marker -irqOvf3
+\ Timer 3 definitions from m128def.inc
+$8a constant tccr3b
+$7d constant etimsk
+#30 constant ovf3Ivec
+
+\ Counter for timer overflows
+variable counter
+
+\ The interrupt routine
+: t3OverflowIsr
+ 1 counter +!
+;i
+
+: irqOvf3Init
+ \ Store the interrupt vector
+ ['] t3OverflowIsr ovf3Ivec int!
+ \ Activate counter 3
+ 1 tccr3b mset
+ \ Activate timer3 overflow interrupt
+ 4 etimsk mset
+;
+: irqOvf3Dis
+ 4 etimsk mclr
+;
+
+irqOvf3Init
+
+counter @ u.
+#1000 ms
+counter @ u.
diff --git a/forth/forth/avr/irqAtmega2560.fs b/forth/forth/avr/irqAtmega2560.fs
new file mode 100644
index 0000000..4a75b87
--- /dev/null
+++ b/forth/forth/avr/irqAtmega2560.fs
@@ -0,0 +1,45 @@
+\ *********************************************************************
+\ Interrupts example for FlashForth *
+\ Filename: irqAtmega2560.txt *
+\ Date: 04.10.2013 *
+\ FF Version: 5.0 *
+\ MCU: Atmega2560 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Disable interrupt before removing the interrupt code
+irqOvf3Dis
+-irqOvf3
+marker -irqOvf3
+\ Timer 3 definitions from m2560def.inc
+$91 constant tccr3b
+$71 constant timsk3
+#36 constant ovf3Ivec
+
+\ Counter for timer overflows
+variable counter
+
+\ The interrupt routine
+: t3OverflowIsr
+ 1 counter +!
+;i
+
+: irqOvf3Init
+ \ Store the interrupt vector
+ ['] t3OverflowIsr ovf3Ivec int!
+ \ Activate counter 3
+ 1 tccr3b mset
+ \ Activate timer3 overflow interrupt
+ 1 timsk3 mset
+;
+: irqOvf3Dis
+ 1 timsk3 mclr
+;
+
+irqOvf3Init
+
+counter @ .
+#1000 ms
+counter @ .
diff --git a/forth/forth/avr/irqAtmega328.fs b/forth/forth/avr/irqAtmega328.fs
new file mode 100644
index 0000000..2f6a53f
--- /dev/null
+++ b/forth/forth/avr/irqAtmega328.fs
@@ -0,0 +1,42 @@
+\ *********************************************************************
+\ Interrupts example for FlashForth *
+\ Filename: irqAtmega328.txt *
+\ Date: 10.11.2014 *
+\ FF Version: 5.0 *
+\ MCU: Atmega328 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Disable interrupt before removing the interrupt code
+irqOvf2Dis
+-irqOvf2
+marker -irqOvf2
+\ Timer 2 definitions from m328pdef.inc
+$b1 constant tccr2b
+$70 constant timsk2
+#10 constant ovf2Ivec
+
+\ Counter for timer overflows
+variable counter
+
+\ The interrupt routine
+: t2OverflowIsr
+ 1 counter +!
+;i
+
+: irqOvf2Init
+ \ Store the interrupt vector
+ ['] t2OverflowIsr ovf2Ivec int!
+ \ Activate counter 2
+ 3 tccr2b c!
+ \ Activate timer2 overflow interrupt
+ 1 timsk2 mset
+;
+: irqOvf2Dis
+ 1 timsk2 mclr
+;
+
+\ irqOvf2Init
+
diff --git a/forth/forth/avr/pick.fs b/forth/forth/avr/pick.fs
new file mode 100644
index 0000000..b27dfcb
--- /dev/null
+++ b/forth/forth/avr/pick.fs
@@ -0,0 +1,6 @@
+\ PICK for the Atmega by
+\ Pablo - EA4FUK
+
+\ xu ... x0 u -- xu ... x0 xu
+: pick 2* sp@ + @ ;
+
diff --git a/forth/see.fs b/forth/forth/avr/see.fs
index a1c2deb..a1c2deb 100644
--- a/forth/see.fs
+++ b/forth/forth/avr/see.fs
diff --git a/forth/forth/avr/task-test-arduino-mega2560.fs b/forth/forth/avr/task-test-arduino-mega2560.fs
new file mode 100644
index 0000000..2f47a29
--- /dev/null
+++ b/forth/forth/avr/task-test-arduino-mega2560.fs
@@ -0,0 +1,48 @@
+\ *******************************************************************
+\ *
+\ Filename: task-test-arduino-uno.txt *
+\ Date: 02.10.2013 *
+\ FF Version: 5.0 *
+\ MCU: ArduinoMega2560R3 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ Demo for the ArduinoMega2560R3. Blinks red led in background task.
+single
+-task1
+marker -task1
+ram hex
+\ Registers for Atmega 2560.
+$0025 constant portb
+$0024 constant ddrb
+$0023 constant pinb
+$80 constant pin7
+ram variable delay
+: ledoff pin7 portb mclr ;
+: ledon pin7 portb mset ;
+
+0 18 20 0 task: task1
+: taskloop
+ $100 delay !
+ pin7 ddrb mset \ Output
+ begin
+ delay @ ms
+ pin7 portb mtst
+ if
+ ledoff
+ else
+ ledon
+ then
+ again
+;
+
+: t1go
+ ['] taskloop task1 tinit
+ task1 run
+;
+
+' t1go is turnkey
+warm
+
diff --git a/forth/forth/avr/task-test-arduino-uno.fs b/forth/forth/avr/task-test-arduino-uno.fs
new file mode 100644
index 0000000..a119ae5
--- /dev/null
+++ b/forth/forth/avr/task-test-arduino-uno.fs
@@ -0,0 +1,45 @@
+\ *******************************************************************
+\ *
+\ Filename: task-test-arduino-uno.txt *
+\ Date: 01.10.2013 *
+\ FF Version: 5.0 *
+\ MCU: ArduinoUnoR3 ATmega328P *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ Demo for the ArduinoUnoR3. Blinks yellow led in background task.
+single
+-task1
+marker -task1
+ram hex
+\ Registers for Atmega 328p.
+$0025 constant portb
+$0024 constant ddrb
+$0023 constant pinb
+$20 constant pin5
+ram variable delay
+: ledoff pin5 portb mclr ;
+: ledon pin5 portb mset ;
+
+0 18 20 0 task: task1
+: taskloop
+ $100 delay !
+ pin5 ddrb mset \ Output
+ begin
+ delay @ ms
+ pin5 portb mtst
+ if
+ ledoff
+ else
+ ledon
+ then
+ again
+;
+
+: t1go ['] taskloop task1 tinit task1 run ;
+
+' t1go is turnkey
+warm
+
diff --git a/forth/forth/avr/task-test.fs b/forth/forth/avr/task-test.fs
new file mode 100644
index 0000000..815aaf4
--- /dev/null
+++ b/forth/forth/avr/task-test.fs
@@ -0,0 +1,45 @@
+\ *******************************************************************
+\ *
+\ Filename: task-test.txt *
+\ Date: 06.01.2014 *
+\ FF Version: 5.0 *
+\ MCU: Atmega 128(Olimex AVR-MT-128) *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ Demo for the Olimex AVR-MT-128. Switches relay and blinks led in
+\ background task.
+single
+-task1
+marker -task1
+ram hex
+\ Registers for Atmega 128. Change if needed
+$003b constant porta
+$003a constant ddra
+$0039 constant pina
+$40 constant pin6
+ram variable delay
+: ledoff pin6 porta mclr ;
+: ledon pin6 porta mset ;
+
+0 18 20 0 task: task1
+: taskloop
+ 400 delay !
+ $40 ddra mset \ Output
+ begin
+ delay @ ms
+ pin6 porta mtst
+ if
+ ledoff
+ else
+ ledon
+ then
+ again
+;
+
+: t1go ['] taskloop task1 tinit task1 run ;
+
+\ ' t1go is turnkey
+\ warm
diff --git a/forth/forth/avr/task.fs b/forth/forth/avr/task.fs
new file mode 100644
index 0000000..1a96928
--- /dev/null
+++ b/forth/forth/avr/task.fs
@@ -0,0 +1,160 @@
+\ *******************************************************************
+\ *
+\ Filename: task.txt *
+\ Date: 07.06.2015 *
+\ FF Version: 5.0 *
+\ MCU: Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ TASK leaves the userarea address on the stack.
+\ The basic size of a task is decimal 32 bytes.
+\ The return stack, the parameter stack and the tib buffer areas
+\ are in addition to that.
+\ These are allocated at the end (high address) of the user area.
+\ Own user varibles can be allocated from offset 2 upwards,
+\ below the return stack. Addsize must reflect any additonal
+\ user variables that are used.
+\ uareasize = 32 + rsize + tibsize + ssize + addsize
+\
+\ The operator task is predefined.
+\ flash decimal 72 72 72 0 task: operator
+\
+\ A background task with a 12 cell return stack and a
+\ 12 cell parameter stack and no tib.
+\ flash decimal 0 24 24 0 task: bg1
+\
+\ A background task with also one extra user variable.
+\ flash decimal 0 24 24 2 task: bg2
+\ ram decimal 2 user bg2_cnt
+
+\ Do not use user variables as task specific variables
+\ User variables are needed by _words_common_to_several_tasks_
+\ which need some task specific data storage.
+
+-task
+marker -task
+hex ram
+
+\ Near definition saves memory !
+: up! up ! ;
+: up@ up @ ;
+: op@ operator @ ;
+: ul@ ulink @ ;
+: ul! ulink ! ;
+: op! op@ up! ;
+\ access user variables of other task
+: his ( task-addr var-addr -- addr )
+ up@ - swap @ +
+;
+
+\ Define a new task
+\ A new task must be defined in the flash memory space
+: task: ( tibsize stacksize rsize addsize -- )
+ flash create
+ up@ s0 - dup \ Basic size ts ss rs as bs bs
+ ram here + flash , \ User pointer ts ss rs as bs
+ 4 for
+ over , +
+ next
+ cell+ \ Task size
+ ram allot
+;
+
+\ Initialise a user area and link it to the task loop
+\ May only be executed from the operator task
+: tinit ( taskloop-addr task-addr -- )
+ \ use task user area
+ @+ up! \ a addsize-addr
+ ul@ if \ ? Already running
+ 2drop
+ else
+ \ Pointer to task area
+ dup 2- task !
+ \ r0 = uarea+addsize+rsize
+ @+ swap @+ rot + up@ + \ a ssize-addr r0
+ \ Save r0
+ r0 ! \ a ssize-addr
+ \ s0 = r0 + ssize
+ @ r0 @ + s0 ! \ a
+ \ Store task-loop address to the return stack
+ r0 @ x>r \ rsp
+ \ Store SP to return stack
+ 1- dup s0 @ swap ! \ rsp
+ \ Store current rsp and space for saving TOS and P PAUSE
+ 5 - rsave ! \
+ \ tiu = s0 + 2
+ s0 @ 2+ tiu !
+ 0 ul!
+ 0 task 2+ ! \ clear status and cr flag
+ decimal \ Set the base to decimal
+ then
+ op! \ run the operator task again
+;
+
+\ Insert a new task after operator in the linked list.
+\ May only be executed from the operator task
+: run ( task-addr -- )
+ @ up! ul@ 0= if \ ? Already running
+ up@ \ task-uarea
+ op! ul@ \ task-uarea operator-ulink
+ over ul!
+ swap up! ul!
+ then
+ op! \ run operator task
+;
+
+\ End a task by linking it out from the linked list
+\ May only be executed from the operator task
+: end ( task-addr -- )
+ @ up! ul@ if
+ up@
+ op!
+ begin \ find the uarea in the linked list
+ dup ul@ <> \ uarea flag
+ while
+ ul@ up! \ uarea
+ repeat
+ up@ \ uarea prev-uarea
+ swap up! \ prev-uarea
+ ul@ \ prev-uarea next-uarea
+ 0 ul! \ ulink of a ended task is zero
+ swap up! \ next-uarea
+ ul! \
+ then
+ op!
+;
+
+\ End all tasks except the operator task
+\ May only be executed from the operator task
+: single ( -- )
+ ul@ op@ <> if \ Are there any running tasks
+ ul@ op@ ul! \ link operator to himself
+ up! \ move to next user area
+ begin
+ ul@ op@ <> \ is this the last linked user area
+ while
+ ul@ 0 ul! \ write zero to ulink
+ up! \ and move to next user area
+ repeat
+ 0 ul!
+ op!
+ then
+;
+
+\ List all running tasks
+: tasks ( -- )
+ up@ op!
+ begin
+ up@
+ task @ 6 - op! c>n .id space
+ up!
+ ul@ op@ -
+ while
+ ul@ up!
+ repeat
+ up!
+;
+
diff --git a/forth/forth/avr/task2-test.fs b/forth/forth/avr/task2-test.fs
new file mode 100644
index 0000000..2897fe1
--- /dev/null
+++ b/forth/forth/avr/task2-test.fs
@@ -0,0 +1,47 @@
+\ *******************************************************************
+\ *
+\ Filename: task2-test.txt *
+\ Date: 01.03.2014 *
+\ FF Version: 5.0 *
+\ MCU: Atmega 328(Olimex AVR-P28) *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ Demo for the Olimex AVR-P28 with Atmega328P. Blinks led in
+\ background task.
+single
+-task2
+marker -task2
+ram hex
+\ Registers for Atmega 328P. Change if needed
+$0028 constant portc
+$0027 constant ddrc
+$20 constant pin5
+
+ram variable delay
+
+: ledoff pin5 portc mset ;
+: ledon pin5 portc mclr ;
+
+0 18 20 0 task: task2
+: task2loop
+ 100 delay !
+ pin5 ddrc mset \ Output
+ begin
+ delay @ ms
+ pin5 portc mtst
+ if
+ ledon
+ else
+ ledoff
+ then
+ again
+;
+
+: t2go ['] task2loop task2 tinit task2 run ;
+
+' t2go is turnkey
+warm
+
diff --git a/forth/forth/avr/us.fs b/forth/forth/avr/us.fs
new file mode 100644
index 0000000..2cd0eda
--- /dev/null
+++ b/forth/forth/avr/us.fs
@@ -0,0 +1,37 @@
+\ microseconds delay for Atmega
+-us
+marker -us
+
+\ Opcode only to flash
+: op: ( opcode -- ) flash create , ram does> @ i, ;
+
+\ Atmega wdr instruction
+$95a8 op: wdr,
+
+\ clear watchdog
+: cwd [ wdr, ] ; inlined
+
+\ Clear watchdog (wdr instruction) takes one clock cycle
+\ Adjust the number of CWD to achieve a one us delay
+\ 9 CWD is needed @ 16MHz for ATmega 328 and 2560.
+: us ( u -- ) \ busy wait for u microseconds
+ begin
+ cwd cwd cwd cwd cwd cwd cwd cwd cwd
+ 1- dup
+ 0= until
+ drop
+;
+
+\ Helper word for calibrating the us loop
+-us-cal
+marker -us-cal
+: us-cal ( u -- ) \ give target delay in ms
+ ticks >r
+ for #1000 us next
+ ticks r> - #1000 um*
+ cr d. ." microseconds"
+;
+
+decimal
+1000 us-cal
+
diff --git a/forth/forth/avr/xdump.fs b/forth/forth/avr/xdump.fs
new file mode 100644
index 0000000..e8a4d93
--- /dev/null
+++ b/forth/forth/avr/xdump.fs
@@ -0,0 +1,45 @@
+\ *********************************************************************
+\ *
+\ Filename: xdump.txt *
+\ FlashForth: 5.0 *
+\ MCU ATmega *
+\ Application: *
+\ *
+\ Author: Mikael Nordman *
+\ *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+
+-xdump
+marker -xdump
+
+\ Display the contents of raw FLASH memory,
+\ given the starting address and length.
+\ The address is a raw address without mapping
+\ Displays in hex notation and printable ASCII.
+\ xdump expects base to be hex.
+\
+
+: ud.r <# 1- for # next #s #> type ;
+: u.2 $ff and 0 2 ud.r space ;
+: xx@ 2dup x@ dup ;
+
+\ Extended Memory Dump.
+\
+: xdump ( d.addr +n -- )
+ rot $fffe and \ start on even address
+ rot rot $10 u/ \ number of rows to print
+ for
+ cr 2dup 6 ud.r
+ [char] : emit space \ display row addr
+ $8 for
+ xx@ u.2 #8 rshift u.2 2 m+
+ next
+ -$10 m+ \ wind back the addr
+ $8 for \ print ASCII
+ xx@ >pr emit >< >pr emit 2 m+
+ next
+ next
+ 2drop cr ;
+
diff --git a/forth/forth/case-test.fs b/forth/forth/case-test.fs
new file mode 100644
index 0000000..40aaf03
--- /dev/null
+++ b/forth/forth/case-test.fs
@@ -0,0 +1,23 @@
+-case-test
+marker -case-test
+ram hex
+
+: case-test
+ case
+ 2 of ." two " 2222 endof
+ 3 of ." three " 3333 endof
+ default ." default " 9999 endof
+ endcase
+ u.
+;
+
+2 case-test
+3 case-test
+8 case-test
+
+: case-test2
+ case
+ 11 of endof
+ default endof
+ endcase
+;
diff --git a/forth/forth/case.fs b/forth/forth/case.fs
new file mode 100644
index 0000000..b50070f
--- /dev/null
+++ b/forth/forth/case.fs
@@ -0,0 +1,52 @@
+\ *********************************************************************
+\ Case for FlashForth *
+\ Filename: case.txt *
+\ Date: 26.01.2014 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ A case implementation posted by Jenny Brien on c.l.f.
+\ Modified to use for..next instead of do..loop
+
+-case
+marker -case
+hex ram
+
+\ of compare
+: (of) ( n1 n2 -- n1 flag )
+ inline over
+ inline -
+ 0=
+;
+
+: case ( -- #of )
+ 0
+; immediate
+
+: of ( #of -- #of orig )
+ postpone (of) ( copy and test case value)
+ postpone if ( add orig to control flow stack )
+ postpone drop ( discard case value if case is matching )
+; immediate
+
+: default ( #of -- #of orig )
+ postpone true ( Force to take the default branch )
+ postpone if ( add orig to control flow stack )
+ postpone drop ( discard case value )
+; immediate
+
+: endof ( orig1 -- orig2 #of )
+ postpone else
+ swap 1+
+; immediate
+
+: endcase ( orig1..orign #of -- )
+ postpone drop ( discard case value )
+ for
+ postpone then ( resolve of branches )
+ next
+; immediate
+
diff --git a/forth/forth/core.fs b/forth/forth/core.fs
new file mode 100644
index 0000000..feaea2a
--- /dev/null
+++ b/forth/forth/core.fs
@@ -0,0 +1,49 @@
+\ *********************************************************************
+\ *
+\ Filename: core.txt *
+\ Date: 31.12.2013 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Some extra core words
+
+-core
+marker -core
+hex ram
+
+\ Interpret a string. The string must be in ram
+: evaluate ( caddr n -- )
+ 'source 2@ >r >r >in @ >r
+ interpret
+ r> >in ! r> r> 'source 2!
+;
+
+: forget ( --- name )
+ bl word latest @ (f) ?abort?
+ c>n 2- dup @ ?abort?
+ dup flash dp ! @ latest ! ram
+;
+
+ ( addr n c -- ) \ fill addr to addr+n with c
+: fill rot !p>r swap for dup pc! p+ next r>p drop ;
+
+\ addr n --
+: erase 0 fill ;
+
+\ addr n --
+: blanks bl fill ;
+
+\ x -- 0 | x x
+: ?dup dup if inline dup then ;
+
+\ nfa -- flag
+: in? c@ $40 and ;
+
+\ addr -- addr+1 n
+: count c@+ ;
+
+hex ram
+
diff --git a/forth/forth/ct-test.fs b/forth/forth/ct-test.fs
new file mode 100644
index 0000000..6837d87
--- /dev/null
+++ b/forth/forth/ct-test.fs
@@ -0,0 +1,22 @@
+\ USAGE EXAMPLE
+: ?9 dup 9 = ;
+: ?6 dup 6 = ;
+: .9 ." nine" cr ;
+: .6 ." six" cr ;
+' .6 ' ?6 ' .9 ' ?9
+2 flash ct test ram
+
+\ WITH noname:
+
+:noname ." default" cr ;
+' true
+:noname ." six" cr ;
+:noname dup 6 = ;
+:noname ." nine" cr ;
+:noname dup 9 = ;
+3 flash ct testnoname
+
+6 test
+6 testnoname
+.
+.
diff --git a/forth/forth/ct.fs b/forth/forth/ct.fs
new file mode 100644
index 0000000..1e3ef04
--- /dev/null
+++ b/forth/forth/ct.fs
@@ -0,0 +1,40 @@
+\ *********************************************************************
+\ *
+\ Filename: ct.txt *
+\ Date: 06.01.2014 *
+\ File Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ create an condition table with n entries
+\ each entry consists of a comparison word
+\ and an execution word, which is executed if
+\ the comparison word leaves a true value on the stack.
+-ct
+marker -ct
+hex ram
+: ct ( ew cw n -- ) \ compile a condition table
+ ( m -- m ) \ execute aword corresponding to m.
+ \ m may consist of several stack cells
+ \ it is upto the condition word to
+ \ preserve m on the stack
+ create
+ dup , \ store the condition table size
+ for
+ , , \ store an entry
+ next
+ does> \ m addr
+ dup @ \ m addr n
+ for
+ cell+ dup \ m addr addr
+ cell+ >r \ m addr
+ @ex \ m flag
+ if \ m
+ r> @ex rdrop exit \ m a match was found
+ then
+ r>
+ next
+ drop
+;
diff --git a/forth/forth/doloop-test.fs b/forth/forth/doloop-test.fs
new file mode 100644
index 0000000..c526a8a
--- /dev/null
+++ b/forth/forth/doloop-test.fs
@@ -0,0 +1,32 @@
+\ test some do loop words
+-test
+marker -test
+decimal
+
+: tdo0 3 0 do cr i . loop ;
+: tdo1 do i . i 5 = if leave then loop cr ." leaving" ;
+: tdo2 do 10 0 do j . i . loop loop ;
+: tdo3 ?do i . 1 +loop cr ." leaving" ;
+: tdo4 do i . 10 +loop ;
+: tdo5 do i . -10 +loop ;
+: tdo ticks #30000 0 do loop ticks swap - u. ;
+: tfor ticks #30000 for next ticks swap - u. ;
+\
+cr
+tdo0
+cr
+10 0 tdo1
+cr
+3 0 tdo2
+cr
+0 0 tdo3
+cr
+10 0 tdo3
+cr
+100 0 tdo4
+cr
+0 100 tdo5
+cr
+tdo
+cr
+tfor
diff --git a/forth/forth/dump.fs b/forth/forth/dump.fs
new file mode 100644
index 0000000..7a6908f
--- /dev/null
+++ b/forth/forth/dump.fs
@@ -0,0 +1,26 @@
+\ *******************************************************************
+\ *
+\ Filename: dump.txt *
+\ Date: 14.11.2010 *
+\ FF Version: 3.6 4.7 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+: dump ( addr +n -- )
+ $10 u/
+ for
+ cr dup 4 u.r [char] : emit \ display row addr
+ $10
+ for \ display bytes
+ c@+ 2 u.r
+ next
+ $10 -
+ $10
+ for \ display ASCII
+ c@+ >pr emit
+ next
+ next
+ drop cr
+;
diff --git a/forth/forth/forget.fs b/forth/forth/forget.fs
new file mode 100644
index 0000000..8e226fd
--- /dev/null
+++ b/forth/forth/forget.fs
@@ -0,0 +1,18 @@
+\ *********************************************************************
+\ *
+\ Filename: core.txt *
+\ Date: 31.12.2013 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Some extra core words
+
+: forget ( --- name )
+ bl word latest @ (f) ?abort?
+ c>n 2- dup @ ?abort?
+ dup flash dp ! @ latest ! ram
+;
+
diff --git a/forth/forth/free.fs b/forth/forth/free.fs
new file mode 100644
index 0000000..e4974a6
--- /dev/null
+++ b/forth/forth/free.fs
@@ -0,0 +1,25 @@
+\ *******************************************************************
+\ *
+\ Filename: free.txt *
+\ Date: 06.01.2014 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+
+\ MCU with eeprom
+: .free
+ cr ." Flash:" flash hi here - u. ." bytes"
+ cr ." Eeprom:" eeprom hi here - u. ." bytes"
+ cr ." Ram:" ram hi here - u. ." bytes"
+;
+
+\ MCU without eeprom
+: .free
+ decimal
+ cr ." Flash:" flash hi here - u. ." bytes"
+ cr ." Ram:" ram hi here - u. ." bytes"
+;
+
diff --git a/forth/forth/help.fs b/forth/forth/help.fs
new file mode 100644
index 0000000..8128b6a
--- /dev/null
+++ b/forth/forth/help.fs
@@ -0,0 +1,68 @@
+\ *******************************************************************
+\ *
+\ Filename: help.txt *
+\ Date: 03.03.2014 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+-help
+marker -help
+ram hex
+
+$1b constant esc
+$09 constant tab
+$0d constant ret
+$0a constant nl
+
+flash hi $32ff - constant ahelp \ Start of help text area
+ram
+
+: h= ( caddr caddr1 u -- flag )
+ swap !p>r
+ for
+ c@+ pc@ p+ -
+ if drop false rdrop r>p exit then
+ next
+ r>p drop true
+;
+
+
+: .help ( addr -- )
+ cr
+ begin
+ c@+ dup emit ret =
+ until
+ cr drop
+;
+: help ( "name" -- )
+ bl word \ addr
+ dup c@ 0= if words abort then
+ ahelp !p>r
+ begin
+ busy pause idle
+ @p over c@+ h= if @p .help r>p drop exit then
+ begin
+ pc@ ret = pc@ nl = or
+ p+
+ pc@ ret <> pc@ nl <> and
+ and
+ until
+ pc@ [char] | =
+ until
+ r>p drop
+;
+
+: loadhelp ( -- store help info )
+ ahelp !p>r \ Help info stored here
+ begin
+ key
+ dup emit
+ dup pc! p+
+ [char] | =
+ until
+ r>p
+;
+
diff --git a/forth/forth/helpwords.fs b/forth/forth/helpwords.fs
new file mode 100644
index 0000000..4fd0005
--- /dev/null
+++ b/forth/forth/helpwords.fs
@@ -0,0 +1,255 @@
+loadhelp
+! x addr -- Store x to addr
+!p addr -- Store addr to p(ointer) register
+!p>r addr -- Compile Only. Push contents of p to return stack and stor addr to p
+# u1 -- u2 Compile Only. Convert 1 digit to formatted numeric string
+#> u1 -- c-addr u Compile Only. Leave address and count of formatted numeric string
+#s u1 -- u2 Compile Only Convert remaining digits to formatted numeric output
+' -- xt Parse word and find it in dictionary
+'source -- a-addr User Variable Current input source
+( -- Skip input on the same line until ) is encountered
+* u1/n1 u2/n2 -- u3/n3 Signed and unsigned 16*16->16 bit multiplikation
++ n1 n2 -- n3 Add n1 to n2
++! n addr -- Add n to cell at addr
+, x -- Append x to the current data section
+- n1 n2 -- n3 Subtract n2 from n1
+. n -- Display n signed according to base
+.s -- Display the stack contents
+.st -- Emit status string for base, current data section, and display the stack contents
+/ n1 n2 -- n3 16/16->16 bit division
+/string addr u n -- addr+n u-n Trim string
+0< n -- flag Leave true flag if n is less than zero
+0= x -- flag Leave true flag if x is zero
+1 -- 1
+1+ n -- n1 Add one to n
+1- n -- n1 Subtract 1 from n
+2* u1 -- u2 Shift u1 left one bit
+2+ n -- n1 Add two to n
+2- n -- n1 Subtract 2 from n
+2/ n1 -- n2 Shift n1 right one bit.
+2@ a-addr -- x1 x2 Fetch two cells
+2! x1 x2 a-addr -- Store two cells
+2drop x1 x2 -- Drop two cells
+2dup x1 x2 -- x1 x2 x1 x2 Duplicate two top cells
+: "name" -- Begin a colon definition
+:noname -- addr Define headerless forth code
+; -- Compile Only. End a colon definition
+;i -- Compile Only. End a interrupt word
+< n1 n2 -- flag Leave true flag if n1 is less than n2
+<# -- Compile Only. Begin numeric conversion
+<> x1 x2 -- flag Leave true flag if x1 and x2 are not equal
+= x1 x2 -- flag Leave true flag if x1 and x2 are equal
+> n1 n2 -- flag Leave true flag if n1 is grater than n2
+>body xt -- a-addr Leave the parameter field address of a created word
+>digit n -- c Convert n to ascii character value
+>in -- a-addr User Variable. Holds offset into tib
+>number n1 addr1 u1 -- n2 addr2 u2 Convert string to number
+>r x -- R: -- x Compile Only. Push x from the parameter stack to the return stack
+?abort flag c-addr u -- Print message and abort if flag is true
+?abort? flag -- If flag is true, emit ? and abort
+?negate n1 n2 -- n3 Negate n1 if n2 is negative
+@ addr -- x Fetch x from addr
+@+ addr1 -- addr2 x Fetch cell from addr1 and increment addr1 by a cell
+@p -- addr Fetch the p register to the stack
+@ex addr -- Fetch vector from addr and execute.
+[ -- Enter interpreter state
+['] "name" -- Compile Only. Compile xt of name as a literal
+[char] "char" -- Compile Only. Compile inline ascii character
+[i -- Compile Only. Enter Fort interrupt context
+\ -- Skip rest of line
+] -- Enter compilation state
+abort -- Reset stack pointer and execute quit
+abort" "string" -- Compile Only. Compile inline string and postpone abort?
+abs n -- n1 Leave absolute value of n
+accept c-addr +n -- +n' Get line from terminal
+again addr -- Compile Only. begin ... again
+align -- Align the current data section dictionary pointer to cell boundary
+aligned addr -- a-addr Align addr to a cell boundary.
+allot n -- Adjust the current data section dictionary pointer
+and x1 x2 -- x3 Bitwise and of x1 and x2
+base a-addr User Variable. Numeric conversion base
+begin -- a-addr Compile Only. Begin loop definition
+bin -- Set base to binary
+bl -- c Ascii space
+c! c addr -- Store c to addr
+c@ addr -- c Fetch c from addr
+c@+ addr1 -- addr2 c Fetch char from addr1 and increment addr1
+c, c -- Append c to the current data section
+cell -- n Leave the size of one cell in characters.
+cell+ addr1 -- addr2 Add cell size to addr1
+cells x1 -- x2 Convert cells to address units.
+char "char" -- n Parse a char and leave ascii value on stack
+char+ c-addr1 -- c-addr2 Add one to c.addr1
+chars x1 -- x2 Convert characters to address units
+cf, xt -- Compile xt into the flash dictionary.
+cfa>nfa addr1 -- addr2 Convert cfa to nfa
+cmove addr1 addr2 u -- Move u chars from addr1 to addr2
+cold -- Make a cold start. Reset all dictionary pointers.
+con x "name" -- Create a constant in rom as inline code
+constant x "name" -- Create an constant in rom with docreate as runtime
+cr -- Emit CR LF
+create "name" -- Create a word definition and store the current data section pointer.
+cse -- addr Ram variable holding the current data section value
+cwd -- Clear the WatchDog counter.
+decimal -- Set numeric base to decimal 10.
+defer "name -- Define a deferred execution vector
+di -- Disable interrupts
+digit? c -- n flag Convert char to a digit according to base
+does> -- Compile Only. Define the runtime action of a created word.
+dp -- addr Eeprom variable mirrored in ram. Dictionary pointer
+drop x1 -- Drop top of stack
+dump addr u -- Display a memory dump
+dup x -- x x Duplicate top of stack
+ei -- Enable interrupts
+end task-addr -- Remove a task from the task list.
+eeprom -- Set data section context to eeprom
+else addr1 -- addr2 Compile Only. if ... else ... then
+emit c -- Emit c to the serial port FIFO. FIFO is 46 chars. Executes pause.
+evaluate c-addr n -- Evaluate ram buffer
+execute addr -- Execute word at addr
+exit -- Exit from a word.
+false -- 0
+flash -- Set data section context to flash
+fill c-addr u c -- Fill u bytes with c staring at c-addr
+find c-addr -- c-addr 0/1/-1 Find a word in dictionary. Leave 1 if immediate, -1 if normal, 0 if not found
+for u -- Compile Only. Loop u times. for ... next
+forget "name -- Forget name
+here -- addr Leave the current data section dictionary pointer
+hex -- Set numeric base to hexadecimal
+hold c -- Compile Only. Append char to formatted numeric string
+hp -- a-addr User Variable. Hold pointer for formatted numeric output
+i] -- Compile Only. Exit Fort interrupt context
+i, x -- Append x to the flash data section.
+ic, c -- Append c to the flash data section.
+if -- a-addr Compile Only. if ... else ... then
+iflush -- Flush the flash write buffer
+immed? addr -- n Leave a nonzero value if addr contains a immediate flag
+immediate -- Mark latest definition as immediate
+in? nfa -- flag Leave true flag if nfa has inline bit set
+inline "name" -- Inline the following word.
+inlined -- Mark the latest compiled word as inlined.
+interpret c-addr u -- Interpret the ram buffer
+invert x1 -- x2 ) Ones complement of x1
+irq -- a-addr Ram value. Interrupt vector. Cleared at warm start
+is x "name" -- Set the value a deferred word
+key -- c Get a character from the serial port FIFO. Execute pause until a character is available
+key? -- flag Leave true if character is waiting in the serial port FIFO
+khz -- u Leave the cpu clock in KHz
+latest -- a-addr Variable holding the address of the latest defined word
+leave -- Compile only. Leave a for/next loop when next is encountered. Sets top of return stack to zero
+literal x -- Compile a literal into the dictionary
+lshift x1 u -- x2 Shift x1 u bits to the left
+m+ d1 n -- d2 Add double number d1 to n
+marker "name" -- Mark a dictionary state
+max n1 n2 -- n3 Leave max of n1 and n2
+mclr mask caddr -- AND the contents of ram-caddr with the complement of mask
+min n1 n2 -- n3 Leave min of n1 and n2
+ms +n -- Pause for +n milliseconds
+mset mask caddr -- OR the contents of ram-caddr with mask.
+mtst mask caddr -- x AND the contents of ram-caddr with mask
+n= caddr nfa u -- flag Compare strings in ram(c-addr) and flash(nfa) flag is true if strings match. u<32.
+negate n -- -n negate n
+next bra-addr bc-addr -- Compile Only. for ... next
+nfa>lfa addr1 -- addr2 Convert nfa to lfa
+nip x1 x2 -- x2 Remove x1 from the stack
+number? caddr -- n/caddr flag Convert string to number, # is decimal prefix, $ is hexadecimal prefix, % is binary prefix
+operator -- addr Leave the address of the operator task
+or x1 x2 -- x3 Or bitwise x1 with x2
+over x1 x2 -- x1 x2 x1 Copy x1 to top of stack
+p+ -- Increment P by one
+p2+ -- Add 2 to P
+p++ n -- Add n to P
+p! x -- Store x to the location pointed by P
+pc! c -- Store c to the location pointed by P
+p@ -- x Fetch the cell pointed by P
+pc@ -- c Fetch the char pointed by P
+pad -- a-addr : pad ram here $20 + ;
+pause -- Switch task
+place addr1 u addr2 -- Place string from addr1 to addr2 as a counted string
+postpone "name" -- Compile Only. Postpone action of immediate word
+prompt -- a-addr Deferred execution vector for the info displayed by quit. ' .st is defer
+quit -- Interpret from keyboard
+r> -- x R: x -- Compile Only. Pop x from the return stack to the parameter stack
+r>p -- R: x -- Compile Only. Pop from return stack to p register
+r@ -- x R: x -- x Compile Only. Copy x from the return stack to the parameter stack
+ram -- Set data section context to ram
+rcnt -- a-addr User Variable. Number of saved return stack cells
+rdrop -- R: x -- Compile Only. Remove top element from return stack
+repeat addr2 addr1 -- Compile Only. begin ... while ... repeat
+rhere -- addr Start of free ram
+rot x1 x2 x3 -- x2 x3 x1 Rotate three top stack items
+rsave -- a-addr User variable. Return stack save area
+rshift x1 u -- x2 Shift x1 u bits to the right
+run task-addr -- Link the task to the task list. The task starts running immediately.
+s0 -- a-addr Variable for start of parameter stack
+scan c-addr u c -- c-addr' u' Scan string until c is found. c-addr must point to ram. u<255
+sign n -- Append minus sign to formatted numeric output
+sign? addr1 n1 -- addr2 n2 flag Get optional minus sign
+single -- End all tasks except the operator task.
+skip c-addr u c -- c-addr' u' Skip string until c not encountered. c-addr must point to ram. u<255
+sp@ -- addr Leave parameter stack pointer
+sp! addr -- Set the parameter stack pointer to addr
+s" "text" -- Compile Only. Compile string into flash
+." "text" -- Compile Only. Compile string to print into flash
+source -- c-addr n Current input buffer
+space -- Emit one space character
+spaces n -- Emit n space characters
+ssave -- a-addr User Variable. Saved return stack pointer
+state -- a-addr User Variable. Compilation state
+swap x1 x2 -- x2 x1 Swap two top stack items
+task: tibsize stacksize rstacksize addsize -- Define a task
+tinit taskloop-addr task-addr -- Initialise the user area and link it to a task loop
+then addr -- Compile Only. if ... else ... then
+tib -- addr User variable. Terminal input buffer
+ti# -- n Size of terminal input buffer. Task constant
+ticks -- u System ticks. One ms resolution
+to x "name" -- Store x into value "name".
+true -- -1
+tuck x1 x2 -- x2 x1 x2 Insert x2 below x1 in the stack
+turnkey -- a-addr Eeprom value mirrored in ram. Vector for user startup word
+type c-addr u -- Type line to terminal. u < $100
+u*/mod u1 u2 u3 -- u4(remainder) u5(quotient) Unsigned u1*u2/u3 with 32 bit intermediate result
+u. u -- Display u unsigned according to numeric base
+u.r u +n -- Display u in field of width n. 0<n<256
+u/ u1 u2 -- u3 Unsigned 16/16->16 bit division
+u/mod u1 u2 -- u3(remainder) u4(quotient) Unsigned 16/16->16 bit division
+u< u1 u2 -- flag Leave true flag if u1 is less than u2
+u> u1 u2 -- flag Leave true flag if u1 is greater than u2
+ulink -- a-addr USER. Link to next task
+um* u1 u2 -- ud Unsigned 16x16 -> 32 bit multiply
+um/mod ud u1 -- u2(remainder) u3(quotient) unsigned 32/16 -> 16 bit division
+umax u1 u2 -- u Leave the unsigned larger of u1 and u2.
+umin u1 u2 -- u Leave the unsigned smaller of u1 and u2.
+until flag -- Compile only. begin..until
+up -- a-addr Variable holding the user pointer
+user n "name" -- Define a user variable at offset n
+value x "name" -- Define a value
+variable "name" -- Create a variable in the current data section
+warm -- Make a warm start
+while addr1 -- addr2 addr1 Compile Only. begin ... while ... repeat
+within x xl xh -- flag Leave true if xl <= x < xh
+word c -- c-addr Copy a word delimited by c to c-addr
+words -- List words
+xor x1 x2 -- x3 Xor bitwise x1 with x2.
+btfsc, f b a --
+btfss, f b a --
+bcf, f b a --
+bsf, f b a --
+andlw, k --
+movf, f d a --
+a, -- 0
+w, -- 0
+call, addr --
+goto, addr --
+rcall, rel-addr --
+bra, rel-addr --
+z, -- cc
+nz, -- cc
+not, cc -- not-cc
+if, cc -- here
+else, back-addr -- here
+then, back-addr --
+begin, -- here
+again, back-addr --
+until, back-addr cc --
+|
diff --git a/forth/forth/i2c-detect.fs b/forth/forth/i2c-detect.fs
new file mode 100644
index 0000000..57b6011
--- /dev/null
+++ b/forth/forth/i2c-detect.fs
@@ -0,0 +1,54 @@
+\ i2c-detect.txt
+\ Detect presence of all possible devices on I2C bus.
+\ Only the 7 bit address schema is supported.
+\
+\ Copied from amForth distribution (lib/hardware/)
+\ and lightly edited to suit FlashForth 5.0 on AVR.
+\ Builds upon i2c-base.
+\ Peter J. 2014-10-27
+\ Mikael N. 2017-5-12 for..next instead of do..loop
+-i2c-detect
+marker -i2c-detect
+
+\ not all bitpatterns are valid 7bit i2c addresses
+: i2c.7bitaddr? ( a -- f) $7 $78 within ;
+
+: i2c.detect ( -- )
+ i2c.init
+ base @ hex
+ \ header line
+ cr 5 spaces 0 $10 for dup 2 u.r 1+ next drop
+ 0 $80 for
+ dup $0f and 0= if
+ cr dup 2 u.r [char] : emit space
+ then
+ dup i2c.7bitaddr? if
+ dup i2c.ping? if \ does device respond?
+ dup 2 u.r
+ else
+ ." -- "
+ then
+ else
+ ." "
+ then
+ 1+
+ next drop
+ i2c.stop
+ cr base !
+;
+
+\ With a lone Microchip TC74A0 sitting on the bus,
+\ the output looks like
+\ ok<$,ram>
+\ i2c.detect
+\ 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f
+\ 00 : -- -- -- -- -- -- -- -- --
+\ 10 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+\ 20 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+\ 30 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+\ 40 : -- -- -- -- -- -- -- -- 48 -- -- -- -- -- -- --
+\ 50 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+\ 60 : -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+\ 70 : -- -- -- -- -- -- -- --
+\ ok<$,ram>
+
diff --git a/forth/forth/jmptbl-test.fs b/forth/forth/jmptbl-test.fs
new file mode 100644
index 0000000..a49b1d9
--- /dev/null
+++ b/forth/forth/jmptbl-test.fs
@@ -0,0 +1,70 @@
+\ *********************************************************************
+\ *
+\ Filename: jmptbl-test.txt *
+\ FlashForth: 5.0 *
+\ *
+\ Author: Pete Zawasky *
+\ Created: Tuesday, January 15 2008 - 18:50 ppz *
+\ Last Edit Tuesday, January 29 2008 - 12:25 ppz *
+\ *
+\ *********************************************************************
+\ Based on jt.fth by Mikael Nordman, Jump_Table by Haskell *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License *
+\ *********************************************************************
+
+hex
+
+\ Create an execution table with n entries.
+\ Each entry consists of 'nn' cell sized comparison value
+\ and 'an' the address of the corresponding word to be executed.
+\ At least two entries must be provided, the last one being the
+\ default action.
+\
+\ Jump Table (from Haskell)
+\ Example:
+\
+\ JUMP_TABLE do.key
+\ control H | bkspace
+\ control Q | quit
+\ HEX 2B | escape DECIMAL
+\ DEFAULT | chrout
+\ Useage:
+\ do.key ( n -- ) \ enter with n=code-to-match on TOS
+\
+
+\ *********************************************************************
+hex ram
+
+: .1st ( -- )
+ ." First "
+;
+
+: .2nd ( -- )
+ ." Second "
+;
+
+: .3rd ( -- )
+ ." Third "
+;
+
+: .4th ( -- )
+ ." Default "
+;
+
+jumptable do_test
+ $00 | .1st
+ $01 | .2nd
+ $02 | .3rd
+ default| .4th
+
+ram
+1 do_test
+2 do_test
+9 do_test
+
+\ 1 do_test Second ok <16,2>
+\ 2 do_test Third ok <16,2>
+\ 9 do_test Default ok <16,2>
+
+
diff --git a/forth/forth/jmptbl.fs b/forth/forth/jmptbl.fs
new file mode 100644
index 0000000..764f20f
--- /dev/null
+++ b/forth/forth/jmptbl.fs
@@ -0,0 +1,76 @@
+\ *********************************************************************
+\ *
+\ Filename: jmptbl.txt *
+\ FlashForth: 5.0 *
+\ Application: FP *
+\ *
+\ Author: Pete Zawasky *
+\ Created: Tuesday, January 15 2008 - 18:50 ppz *
+\ Last Edit Tuesday, January 29 2008 - 12:25 ppz *
+\ *
+\ *********************************************************************
+\ Based on jt.fth by Mikael Nordman, Jump_Table by Haskell *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License *
+\ *********************************************************************
+
+-jmptbl
+marker -jmptbl
+
+hex
+
+\ Create an execution table with n entries.
+\ Each entry consists of 'nn' cell sized comparison value
+\ and 'an' the address of the corresponding word to be executed.
+\ At least two entries must be provided, the last one being the
+\ default action.
+\
+\ Jump Table (from Haskell)
+\ Example:
+\
+\ JUMP_TABLE do.key
+\ control H | bkspace
+\ control Q | quit
+\ HEX 2B | escape DECIMAL
+\ DEFAULT| chrout
+\ Useage:
+\ do.key ( n -- ) \ enter with n=code-to-match on TOS
+\
+
+\ Create a jump table.
+\
+: jumptable ( -- ) \ compile an execution table
+ ( m -- ) \ execute a word corresponding to m
+ flash \ The jumptable goes into flash
+ create
+ here 0 , \ initial test_cnt stored at pfa
+ \ ( addr -- )
+ does> \ ( m addr -- )
+ dup @ \ ( m a cnt -- )
+ for
+ cell+
+ 2dup @ = \ ( m a flag -- )
+ if \ a match was found
+ nip cell+ @ex \ execute the matched word
+ rdrop exit \ and exit
+ then
+ cell+ \ ( m a -- ) point to next nn to test
+ next
+ nip cell+ @ex \ execute the default word
+;
+
+\ Use the words | and default| to fill jump table.
+\
+: | ( addr nn -- addr )
+ , ' , \ store m (match) and cfa in table
+ 1 over +! \ increment test_cnt at pfa
+;
+
+: default| ( addr -- )
+ drop ' , \ store default word cfa in table
+;
+
+ram
+
+
+
diff --git a/forth/forth/jt-test.fs b/forth/forth/jt-test.fs
new file mode 100644
index 0000000..9bda3b5
--- /dev/null
+++ b/forth/forth/jt-test.fs
@@ -0,0 +1,9 @@
+\ example
+-tf
+marker -tf
+: .default ." no match " ;
+flash
+' .default 0 ' true 9 ' false 5 3 jt tf
+ram
+5 tf
+9 tf
diff --git a/forth/forth/jt.fs b/forth/forth/jt.fs
new file mode 100644
index 0000000..496a439
--- /dev/null
+++ b/forth/forth/jt.fs
@@ -0,0 +1,42 @@
+\ *********************************************************************
+\ *
+\ Filename: jt.txt *
+\ Date: 06.01.2014 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ create an execution table with n entries
+\ each entry consists of 'nn' cell sized comparison value
+\ and 'an' the address of the corresponding word to be executed.
+\ At least two entries must be provided, the last one beeing the
+\ default action.
+-jt
+marker -jt
+
+: jte nip cell+ @ex ;
+: jt ( an nn n -- ) \ compile an execution table
+ ( m -- ) \ execute aword corresponding to m
+ create
+ dup 1- , \ store the table size
+ for
+ , , \ store an entry
+ next
+ does> \ m addr
+ dup @ \ m a n
+ for
+ cell+
+ 2dup @ = \ m a flag
+ if
+ \ a match was found
+ jte rdrop exit
+ then
+ cell+ \ m a
+ next
+ \ Execute the default action.
+ cell+ jte
+;
+ram
+
diff --git a/forth/forth/math.fs b/forth/forth/math.fs
new file mode 100644
index 0000000..1657af7
--- /dev/null
+++ b/forth/forth/math.fs
@@ -0,0 +1,79 @@
+\ *********************************************************************
+\ *
+\ Filename: math.txt *
+\ Date: 31.12.2013 *
+\ FF Version: 5.0 *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Double, triple and mixed math words
+
+: m* ( n1 n2 -- d )
+ 2dup xor >r
+ abs swap abs um*
+ r> ?dnegate
+;
+
+: sm/rem ( d1 n1 -- n2 n3 )
+ 2dup xor >r over >r
+ abs >r dabs r> um/mod
+ swap r> ?negate
+ swap r> ?negate
+;
+
+: fm/mod ( d1 n1 -- n2 n3 )
+ dup >r
+ 2dup xor >r
+ >r
+ dabs r@ abs um/mod
+ swap r> ?negate swap
+ r> 0< if
+ negate
+ over if
+ r@ rot - swap 1-
+ then
+ then
+ r> drop
+;
+: /mod ( n1 n2 -- n3 n4 )
+ >r s>d r> sm/rem
+;
+: mod ( n1 n2 -- n3 )
+ /mod drop
+;
+
+: */mod ( n1 n2 n3 -- n4 n5 )
+ >r m* r> sm/rem
+;
+: */ ( n1 n2 n3 -- n4 )
+ >r m* r> sm/rem nip
+;
+
+\ multiply single number with double number.
+\ Triple precision (48-bit) result
+: ut* ( ud u -- ut)
+ dup >r swap >r um* r> r> um* >r
+ 0 swap 0 d+ r> +
+;
+
+
+\ Divide triple number with single number
+\ Double result
+: ut/ ( ut u -- ud)
+ dup >r um/mod r> swap >r
+ um/mod swap drop r>
+;
+
+\ Scale with triple number intermediate result
+: um*/ ( ud1 u1 u2 -- ud2)
+ >r ut* r> ut/
+;
+\ Signed scale d1*n1/n2 with intermediate triple result
+: m*/ ( d1 n1 n2 -- d2 )
+ rot dup >r rot rot 2dup xor r> xor >r \ save result sign
+ abs >r abs >r dabs r> r> \ now have S:ud1 u1 u2
+ um*/ r> ?dnegate
+;
+
diff --git a/forth/forth/sieve.fs b/forth/forth/sieve.fs
new file mode 100644
index 0000000..c5e3cd5
--- /dev/null
+++ b/forth/forth/sieve.fs
@@ -0,0 +1,43 @@
+\ *******************************************************************
+\ *
+\ Filename: sieve.txt *
+\ Date: 31.12.2013 *
+\ FF Version: 5.0 *
+\ MCU: PIC 18 24 30 33 Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ This normal sieve requires 8 KBytes of RAM.
+\ It will not run on most PICs due to lack of memory.
+\ sieve2 requires 1 Kbyte of RAM.
+
+-sieve
+marker -sieve
+decimal ram
+8191 constant size inlined
+ram align here size allot constant flags inlined
+: sieve
+ flags size 1 fill
+ 0 1 !p>r size 1-
+ for
+ flags @p + c@
+ if
+ @p dup + 3 +
+ dup @p +
+ begin
+ dup size <
+ while
+ 0 over flags + c!
+ over +
+ repeat
+ drop drop 1+
+ then
+ p+
+ next
+ r>p
+ . ." primes " cr ;
+
+: bench ticks sieve ticks swap - u. ." milliseconds" cr ;
+
diff --git a/forth/forth/sieve2.fs b/forth/forth/sieve2.fs
new file mode 100644
index 0000000..87911c2
--- /dev/null
+++ b/forth/forth/sieve2.fs
@@ -0,0 +1,59 @@
+\ *******************************************************************
+\ *
+\ Filename: sieve2.txt *
+\ Date: 22.02.2014 *
+\ MCU: PIC 18 24 30 33 Atmega *
+\ Copyright: Mikael Nordman *
+\ Author: Mikael Nordman *
+\ *******************************************************************
+\ FlashForth is licensed according to the GNU General Public License*
+\ *******************************************************************
+\ sieve2 requires 1 Kbyte of RAM.
+-sieve2
+marker -sieve2
+decimal ram
+
+ ( addr n c -- ) \ fill addr to addr+n with c
+: fill rot !p>r swap for dup pc! p+ next r>p drop ;
+
+8192 constant size2
+ram variable flags2 size2 8 / allot
+: bit-addr ( addr bit -- eff-addr )
+ 3 rshift ( -- addr off)
+ + ( -- eff-addr) ;
+
+: bit? ( addr bit -- f )
+ swap over bit-addr swap ( -- eff-addr bit )
+ 7 and 1 swap lshift ( -- eff-addr bitmask)
+ swap c@ and ( -- f) ;
+
+: bit-reset ( addr bit -- )
+ swap over bit-addr swap ( -- eff-addr bit )
+ 7 and 1 swap lshift ( -- eff-addr bitmask)
+ invert over c@ and swap c! ;
+
+: sieve2
+ flags2 [ size2 8 / ] literal -1 fill
+ 0 0 !p>r size2
+ for
+ flags2 @p bit?
+ if
+ @p 2* 3 +
+ dup @p +
+ begin
+ dup size2 u<
+ while
+ flags2 over bit-reset
+ over +
+ repeat
+ 2drop 1+
+ then
+ p+
+ next
+ r>p . ." primes " cr
+;
+
+: bench2 ticks sieve2 ticks swap - u. ." milliseconds" cr ;
+
+bench2
+
diff --git a/forth/forth/tc74-app.fs b/forth/forth/tc74-app.fs
new file mode 100644
index 0000000..db7db9b
--- /dev/null
+++ b/forth/forth/tc74-app.fs
@@ -0,0 +1,40 @@
+\ Read temperature from TC74 on I2C bus.
+\ Requires i2c-base.txt to be previously loaded.
+\ Modelled on Mikael Nordman's i2c_tcn75.txt.
+\ Peter J. 2014-10-28
+
+-tc74-app
+marker -tc74-app
+
+%1001000 constant addr-TC74A0
+
+: tc74-init ( -- )
+ \ Selects temperature register for subsequent reads.
+ addr-TC74A0 i2c.addr.write if 0 i2c.c! drop then i2c.stop
+;
+
+: sign-extend ( c -- n )
+ \ If the TC74 has returned a negative 8-bit value,
+ \ we need to sign extend to 16-bits with ones.
+ dup $7f > if $ff80 or then
+;
+
+: degrees@ ( -- n )
+ \ Wake the TC74 and fetch its register value.
+ addr-TC74A0 i2c.addr.read if i2c.c@.nack else 0 then i2c.stop
+ sign-extend
+;
+
+: tc74-main ( -- )
+ i2c.init
+ tc74-init
+ begin
+ degrees@ .
+ #1000 ms
+ key? until
+;
+
+\ Now, report temperature in degrees C
+\ while we warm up the TC74 chip with our fingers...
+\
+\ decimal tc74-main 23 23 23 23 23 23 23 24 24 24 25 25 26 26 26 26 26 27
diff --git a/forth/forth/vt100-test.fs b/forth/forth/vt100-test.fs
new file mode 100644
index 0000000..e3982c4
--- /dev/null
+++ b/forth/forth/vt100-test.fs
@@ -0,0 +1,36 @@
+\ *********************************************************************
+\
+\ Filename: vt100-test.txt
+\ Date: 02.03.2014
+\ FF Version: 5.0
+\ Author: Attila Herman
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Frequently used commands for VT100 compatible terminals
+\ Unfortunately there is some differencies between terminal emulators!
+\ Maybe some words doesn't work, or does another function depending on
+\ terminal.
+
+-vt100-test
+marker -vt100-test
+
+: vt100-test
+ \cls \c-
+ 2 8 \cp
+ \bri s" *** " type
+ \res \rev s" Terminal test " type \res
+ \bri s" ***" type
+ 6 8 \cp \unl s" ^^^^^^^^^^^^^^^^^^^^^^" type
+ 8 8 \cp \res s" Press any key to quit! " type
+ \res \bri \rev
+ 0
+ begin
+ 4 #16 \cp bl emit
+ dup . 1+ s" sec " type
+ #1000 ms
+ key?
+ until
+ key 2drop \res 5 \cdn \nl \c+
+;
+
diff --git a/forth/forth/vt100.fs b/forth/forth/vt100.fs
new file mode 100644
index 0000000..74bda6b
--- /dev/null
+++ b/forth/forth/vt100.fs
@@ -0,0 +1,55 @@
+\ *********************************************************************
+\
+\ Filename: vt100.txt
+\ Date: 02.03.2014
+\ FF Version: 5.0
+\ Author: Attila Herman
+\ *********************************************************************
+\ FlashForth is licensed acording to the GNU General Public License*
+\ *********************************************************************
+\ Frequently used commands for VT100 compatible terminals
+\ Unfortunately there is some differencies between terminal emulators!
+\ Maybe some words doesn't work, or does another function depending on
+\ terminal.
+
+-vt100
+marker -vt100
+
+\ Auxiliary words
+: esc[ #27 emit #91 emit ; \ 'esc' and '[' for starting escape sequence
+: .n ( n -- ) \ Print n without separator space character
+ 0 <# #s #> for dup c@ emit 1+ next drop ;
+: \; [char] ; emit ; \ Emit semicolon character
+
+\ Erasing and cursor positioning words
+: \h esc[ [char] H emit ; \ Cursor to home position
+: \cls esc[ [char] 2 emit [char] J emit ; \ Clear the screen
+: \clsh \cls \h ; \ cls + home
+: \el esc[ [char] 2 emit [char] K emit ; \ Erase line
+: \esl esc[ [char] 1 emit [char] K emit ; \ Erase from start of line
+: \eel esc[ [char] 0 emit [char] K emit ; \ Erase to end of line
+: \nl esc[ [char] E emit ; \ Next line
+: \cu esc[ [char] A emit ; \ Cursor up
+: \cun esc[ .n [char] A emit ; \ Cursor up with n line
+: \cd esc[ [char] B emit ; \ Cursor down
+: \cdn esc[ .n [char] B emit ; \ Cursor down with n line
+: \cf esc[ [char] C emit ; \ Cursor foreward
+: \cfn esc[ .n [char] C emit ; \ Cursor foreward with n position
+: \cb esc[ [char] D emit ; \ Cursor backward
+: \cbn esc[ .n [char] D emit ; \ Cursor backward with n position
+: \cp esc[ swap .n \; .n [char] f emit ; \ Cursor position to line, row
+: \t 9 emit ; \ Cursor to next tab position
+
+\ Attributes
+: \attr esc[ .n [char] m emit ; \ Set the current attribute
+: \res 0 \attr ; \ Reset attributes to default
+: \bri 1 \attr ; \ Bright
+: \unl 4 \attr ; \ Underline
+: \bli 5 \attr ; \ Blinked
+: \rev 7 \attr ; \ Reverse
+: \hid 8 \attr ; \ Hidden
+
+\ Cursor on/off
+: \c+ esc[ [char] ? emit [char] 2 emit [char] 5 emit [char] h emit ;
+: \c- esc[ [char] ? emit [char] 2 emit [char] 5 emit [char] l emit ;
+
diff --git a/forth/main.fs b/forth/main.fs
index bfbf81e..fbb279e 100644
--- a/forth/main.fs
+++ b/forth/main.fs
@@ -1,34 +1,2 @@
--io
-marker -io \ define ports
-
-$0023 constant PB
-$0023 constant pinb
-$0024 constant ddrb
-$0025 constant portb
-
-$0026 constant PC
-$0026 constant pinc
-$0027 constant ddrc
-$0028 constant portc
-
-$0029 constant PD
-$0029 constant pind
-$002a constant ddrd
-$002b constant portd
-
--init
-marker init
-
-: bv ( bit -- mask ) 1 swap lshift ;
-: pin ( bit base-addr -- ) bv swap 2dup 1+ mclr ;
-: port ( bit base-addr -- ) bv swap 1+ 2dup mset 1+ ;
-: set ( mask addr -- ) mset ;
-: clr ( mask addr -- ) mclr ;
-: init
- PB #3 port 2constant servo
- PB #5 port 2constant led
- PD #2 pin 2constant sr
- PD #3 pin 2constant sc
- PD #4 pin 2constant sl
-;
-: get ( mask addr -- bool ) c@ invert and 0= ;
+-main
+marker -main
diff --git a/forth/rand.fs b/forth/rand.fs
new file mode 100644
index 0000000..2bd2447
--- /dev/null
+++ b/forth/rand.fs
@@ -0,0 +1,17 @@
+\ Fast Random Number Generator algorithm by George Marsaglia "Xorshift RNGs"
+
+-rnd
+marker -rnd
+
+: xorshift ( n -- n )
+ dup #13 lshift xor
+ dup #17 rshift xor
+ dup #5 lshift xor
+;
+
+variable (rnd) \ seed
+ticks (rnd) ! \ initialize seed
+
+: rnd ( -- n )
+ (rnd) @ xorshift dup (rnd) !
+;
diff --git a/forth/uno.fs b/forth/uno.fs
new file mode 100644
index 0000000..bd70aa3
--- /dev/null
+++ b/forth/uno.fs
@@ -0,0 +1,138 @@
+-uno
+marker -uno
+
+\ USART0
+$c6 constant UDR0 \ USART I/O Data Register
+$c0 constant UCSR0A \ USART Control and Status Register A
+$c1 constant UCSR0B \ USART Control and Status Register B
+$c2 constant UCSR0C \ USART Control and Status Register C
+$c4 constant UBRR0 \ USART Baud Rate Register Bytes
+
+\ TWI
+$bd constant TWAMR \ TWI (Slave) Address Mask Register
+$b8 constant TWBR \ TWI Bit Rate register
+$bc constant TWCR \ TWI Control Register
+$b9 constant TWSR \ TWI Status Register
+$bb constant TWDR \ TWI Data register
+$ba constant TWAR \ TWI (Slave) Address register
+
+\ TIMER_COUNTER_1
+$6f constant TIMSK1 \ Timer/Counter Interrupt Mask Register
+$36 constant TIFR1 \ Timer/Counter Interrupt Flag register
+$80 constant TCCR1A \ Timer/Counter1 Control Register A
+$81 constant TCCR1B \ Timer/Counter1 Control Register B
+$82 constant TCCR1C \ Timer/Counter1 Control Register C
+$84 constant TCNT1 \ Timer/Counter1 Bytes
+$88 constant OCR1A \ Timer/Counter1 Output Compare Register Bytes
+$8a constant OCR1B \ Timer/Counter1 Output Compare Register Bytes
+$86 constant ICR1 \ Timer/Counter1 Input Capture Register Bytes
+$43 constant GTCCR \ General Timer/Counter Control Register
+
+\ TIMER_COUNTER_2
+$70 constant TIMSK2 \ Timer/Counter Interrupt Mask register
+$37 constant TIFR2 \ Timer/Counter Interrupt Flag Register
+$b0 constant TCCR2A \ Timer/Counter2 Control Register A
+$b1 constant TCCR2B \ Timer/Counter2 Control Register B
+$b2 constant TCNT2 \ Timer/Counter2
+$b4 constant OCR2B \ Timer/Counter2 Output Compare Register B
+$b3 constant OCR2A \ Timer/Counter2 Output Compare Register A
+$b6 constant ASSR \ Asynchronous Status Register
+
+\ AD_CONVERTER
+$7c constant ADMUX \ The ADC multiplexer Selection Register
+$78 constant ADC \ ADC Data Register Bytes
+$7a constant ADCSRA \ The ADC Control and Status register A
+$7b constant ADCSRB \ The ADC Control and Status register B
+$7e constant DIDR0 \ Digital Input Disable Register
+
+\ ANALOG_COMPARATOR
+$50 constant ACSR \ Analog Comparator Control And Status Register
+$7f constant DIDR1 \ Digital Input Disable Register 0x1
+
+\ PORTB
+$25 constant PORTB \ Port B Data Register
+$24 constant DDRB \ Port B Data Direction Register
+$23 constant PINB \ Port B Input Pins
+
+\ PORTC
+$28 constant PORTC \ Port C Data Register
+$27 constant DDRC \ Port C Data Direction Register
+$26 constant PINC \ Port C Input Pins
+
+\ PORTD
+$2b constant PORTD \ Port D Data Register
+$2a constant DDRD \ Port D Data Direction Register
+$29 constant PIND \ Port D Input Pins
+
+\ TIMER_COUNTER_0
+$48 constant OCR0B \ Timer/Counter0 Output Compare Register
+$47 constant OCR0A \ Timer/Counter0 Output Compare Register
+$46 constant TCNT0 \ Timer/Counter0
+$45 constant TCCR0B \ Timer/Counter Control Register B
+$44 constant TCCR0A \ Timer/Counter Control Register A
+$6e constant TIMSK0 \ Timer/Counter0 Interrupt Mask Register
+$35 constant TIFR0 \ Timer/Counter0 Interrupt Flag register
+
+\ EXTERNAL_INTERRUPT
+$69 constant EICRA \ External Interrupt Control Register
+$3d constant EIMSK \ External Interrupt Mask Register
+$3c constant EIFR \ External Interrupt Flag Register
+$68 constant PCICR \ Pin Change Interrupt Control Register
+$6d constant PCMSK2 \ Pin Change Mask Register 0x2
+$6c constant PCMSK1 \ Pin Change Mask Register 0x1
+$6b constant PCMSK0 \ Pin Change Mask Register 0x0
+$3b constant PCIFR \ Pin Change Interrupt Flag Register
+
+\ SPI
+$4e constant SPDR \ SPI Data Register
+$4d constant SPSR \ SPI Status Register
+$4c constant SPCR \ SPI Control Register
+
+\ WATCHDOG
+$60 constant WDTCSR \ Watchdog Timer Control Register
+
+\ CPU
+$64 constant PRR \ Power Reduction Register
+$66 constant OSCCAL \ Oscillator Calibration Value
+$61 constant CLKPR \ Clock Prescale Register
+$5F constant SREG \ Status Register
+$5d constant SP \ Stack Pointer
+$57 constant SPMCSR \ Store Program Memory Control and Status Register
+$55 constant MCUCR \ MCU Control Register
+$54 constant MCUSR \ MCU Status Register
+$53 constant SMCR \ Sleep Mode Control Register
+$4b constant GPIOR2 \ General Purpose I/O Register 0x2
+$4a constant GPIOR1 \ General Purpose I/O Register 0x1
+$3e constant GPIOR0 \ General Purpose I/O Register 0x0
+
+\ EEPROM
+$41 constant EEAR \ EEPROM Address Register Bytes
+$40 constant EEDR \ EEPROM Data Register
+$3f constant EECR \ EEPROM Control Register
+
+\ Interrupts
+$02 constant INT0Addr \ External Interrupt Request 0x0
+$04 constant INT1Addr \ External Interrupt Request 0x1
+$06 constant PCINT0Addr \ Pin Change Interrupt Request 0x0
+$08 constant PCINT1Addr \ Pin Change Interrupt Request 0x0
+$0a constant PCINT2Addr \ Pin Change Interrupt Request 0x1
+$0c constant WDTAddr \ Watchdog Time-out Interrupt
+$0e constant TIMER2_COMPAAddr \ Timer/Counter2 Compare Match A
+$10 constant TIMER2_COMPBAddr \ Timer/Counter2 Compare Match A
+$12 constant TIMER2_OVFAddr \ Timer/Counter2 Overflow
+$14 constant TIMER1_CAPTAddr \ Timer/Counter1 Capture Event
+$16 constant TIMER1_COMPAAddr \ Timer/Counter1 Compare Match A
+$18 constant TIMER1_COMPBAddr \ Timer/Counter1 Compare Match B
+$1a constant TIMER1_OVFAddr \ Timer/Counter1 Overflow
+$1c constant TIMER0_COMPAAddr \ TimerCounter0 Compare Match A
+$1e constant TIMER0_COMPBAddr \ TimerCounter0 Compare Match B
+$20 constant TIMER0_OVFAddr \ Timer/Couner0 Overflow
+$22 constant SPI_STCAddr \ SPI Serial Transfer Complete
+$24 constant USART_RXAddr \ USART Rx Complete
+$26 constant USART_UDREAddr \ USART, Data Register Empty
+$28 constant USART_TXAddr \ USART Tx Complete
+$2a constant ADCAddr \ ADC Conversion Complete
+$2c constant EE_READYAddr \ EEPROM Ready
+$2e constant ANALOG_COMPAddr \ Analog Comparator
+$30 constant TWIAddr \ Two-wire Serial Interface
+$32 constant SPM_ReadyAddr \ Store Program Memory Read