aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/words/does.asm
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/avr8/words/does.asm')
-rw-r--r--amforth-6.5/avr8/words/does.asm53
1 files changed, 53 insertions, 0 deletions
diff --git a/amforth-6.5/avr8/words/does.asm b/amforth-6.5/avr8/words/does.asm
new file mode 100644
index 0000000..6e3e71b
--- /dev/null
+++ b/amforth-6.5/avr8/words/does.asm
@@ -0,0 +1,53 @@
+; ( i*x -- j*y ) (R: nest-sys1 -- ) (C: colon-sys1 -- colon-sys2 )
+; Compiler
+; organize the XT replacement to call other colon code
+VE_DOES:
+ .dw $0005
+ .db "does>",0
+ .dw VE_HEAD
+ .set VE_HEAD = VE_DOES
+XT_DOES:
+ .dw DO_COLON
+PFA_DOES:
+ .dw XT_COMPILE
+ .dw XT_DODOES
+ .dw XT_COMPILE ; create a code snippet to be used in an embedded XT
+ .dw $940e ; the address of this compiled
+ .dw XT_COMPILE ; code will replace the XT of the
+ .dw DO_DODOES ; word that CREATE created
+ .dw XT_EXIT ;
+
+DO_DODOES: ; ( -- PFA )
+ savetos
+ movw tosl, wl
+ adiw tosl, 1
+ ; the following takes the address from a real uC-call
+.if (pclen==3)
+ pop wh ; some 128K Flash devices use 3 cells for call/ret
+.endif
+ pop wh
+ pop wl
+
+ push XH
+ push XL
+ movw XL, wl
+ jmp_ DO_NEXT
+
+; ( -- )
+; System
+; replace the XT written by CREATE to call the code that follows does>
+;VE_DODOES:
+; .dw $ff07
+; .db "(does>)"
+; .set VE_HEAD = VE_DODOES
+XT_DODOES:
+ .dw DO_COLON
+PFA_DODOES:
+ .dw XT_R_FROM
+ .dw XT_NEWEST
+ .dw XT_CELLPLUS
+ .dw XT_FETCH
+ .dw XT_FETCHE
+ .dw XT_NFA2CFA
+ .dw XT_STOREI
+ .dw XT_EXIT