aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/words/itype.asm
blob: 7831344e93c8674d051b3a3aede8bf14535f650b (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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
; ( addr n --  ) 
; Tools
; reads string from flash and prints it
VE_ITYPE:
    .dw $ff05
    .db "itype",0
    .dw VE_HEAD
    .set VE_HEAD = VE_ITYPE
XT_ITYPE:
    .dw DO_COLON
PFA_ITYPE:
    .dw XT_DUP    ; ( --addr len len)
    .dw XT_2SLASH ; ( -- addr len len/2
    .dw XT_TUCK   ; ( -- addr len/2 len len/2
    .dw XT_2STAR  ; ( -- addr len/2 len len'
    .dw XT_MINUS  ; ( -- addr len/2 rem
    .dw XT_TO_R
    .dw XT_ZERO
    .dw XT_QDOCHECK
    .dw XT_DOCONDBRANCH
    .dw PFA_ITYPE2
    .dw XT_DODO
PFA_ITYPE1:
    .dw XT_DUP         ; ( -- addr addr )
    .dw XT_FETCHI      ; ( -- addr c1c2 )
    .dw XT_DUP
    .dw XT_LOWEMIT
    .dw XT_HIEMIT
    .dw XT_1PLUS    ; ( -- addr+cell )
    .dw XT_DOLOOP
    .dw PFA_ITYPE1
PFA_ITYPE2:
    .dw XT_R_FROM
    .dw XT_GREATERZERO
    .dw XT_DOCONDBRANCH
    .dw PFA_ITYPE3
      .dw XT_DUP     ; make sure the drop below has always something to do
      .dw XT_FETCHI
      .dw XT_LOWEMIT
PFA_ITYPE3:
    .dw XT_DROP
    .dw XT_EXIT

; ( w -- )
; R( -- )
; content of cell fetched on stack.
;VE_HIEMIT:
;    .dw $ff06
;    .db "hiemit"
;    .dw VE_HEAD
;    .set VE_HEAD = VE_HIEMIT
XT_HIEMIT:
    .dw DO_COLON
PFA_HIEMIT:
    .dw XT_BYTESWAP
    .dw XT_LOWEMIT
    .dw XT_EXIT

; ( w -- )
; R( -- )
; content of cell fetched on stack.
;VE_LOWEMIT:
;    .dw $ff07
;    .db "lowemit"
;    .dw VE_HEAD
;    .set VE_HEAD = VE_LOWEMIT
XT_LOWEMIT:
    .dw DO_COLON
PFA_LOWEMIT:
    .dw XT_DOLITERAL
    .dw $00ff
    .dw XT_AND
    .dw XT_EMIT
    .dw XT_EXIT