aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/words/does.asm
blob: 6e3e71bd717abe409ceb368d1837a4e94690449a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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