[Amforth-devel] 2constant, 2variable, 2!, 2@, 2drop, 2dup and (2variable) words

[Marcin C. <sa...@sa...>]

Hello,

I have prepared some double-length words for your convenience:

Probably some could be more optimized.

--Marcin

; ( d -- ) Compiler
; R( -- )
; create a named constant
VE_2CONSTANT:
     .dw $ff09
     .db "2constant",0
     .dw VE_HEAD
     .set VE_HEAD = VE_2CONSTANT
XT_2CONSTANT:
     .dw DO_COLON
PFA_2CONSTANT:
     .dw XT_DOCREATE
     .dw XT_COMPILE
     .dw PFA_DO2VARIABLE
     .dw XT_SWAP
     .dw XT_COMMA
     .dw XT_COMMA
     .dw XT_EXIT

; ( d -- ) Stack
; R( -- )
; drop TOS
VE_2DROP:
     .dw $ff05
     .db "2drop",0
     .dw VE_HEAD
     .set VE_HEAD = VE_2DROP
XT_2DROP:
     .dw PFA_2DROP
PFA_2DROP:
     loadtos
     loadtos
     jmp DO_NEXT
; ( d1 -- d1 d1 ) Stack
; R( -- )
; stack manipulation
VE_2DUP:
     .dw $ff04
     .db "2dup"
     .dw VE_HEAD
     .set VE_HEAD = VE_2DUP
XT_2DUP:
     .dw PFA_2DUP
PFA_2DUP:
     savetos
     ldd tosl, Y+2
     ldd tosh, Y+3
     savetos
     ldd tosl, Y+2
     ldd tosh, Y+3
     jmp DO_NEXT
; ( addr -- d ) Memory
; R( -- )
; read 2 cells from RAM (or IO or CPU register)
; byte order is little-endian 44 33 22 11 -> 11223344.
VE_2FETCH:
     .dw $ff02
     .db "2@"
     .dw VE_HEAD
     .set VE_HEAD = VE_2FETCH
XT_2FETCH:
     .dw PFA_2FETCH
PFA_2FETCH:
     movw zl, tosl
     ld tosl, z+
     ld tosh, z+
 	savetos
     ld tosl, z+
     ld tosh, z+
     jmp DO_NEXT
; ( d addr -- ) Memory
; R( -- )
; write 32bit to RAM memory (or IO or CPU registers)
; words are stored little-endian, so 12345678. becomes
; 78 56 34 12
VE_2STORE:
     .dw $ff02
     .db "2!"
     .dw VE_HEAD
     .set VE_HEAD = VE_2STORE
XT_2STORE:
     .dw PFA_2STORE
PFA_2STORE:
     movw zl, tosl
     loadtos
     std Z+2, tosl
     std Z+3, tosh
     loadtos
     std Z+0, tosl
     std Z+1, tosh
     loadtos
     jmp DO_NEXT
; ( -- ) Compiler
; R( -- )
; create a variable entry and allocate RAM space for it
VE_2VARIABLE:
     .dw $ff09
     .db "2variable",0
     .dw VE_HEAD
     .set VE_HEAD = VE_2VARIABLE
XT_2VARIABLE:
     .dw DO_COLON
PFA_2VARIABLE:
     .dw XT_HERE
     .dw XT_CONSTANT
     .dw XT_DOLITERAL
     .dw 4
     .dw XT_ALLOT
     .dw XT_EXIT
; ( -- addr )
; R( -- )
; puts content of parameter field (2 cells) to TOS
;VE_DO2VARIABLE:
;    .dw $ff0b
;    .db "(2variable)",0
;    .dw VE_HEAD
;    .set VE_HEAD = VE_DO2VARIABLE
XT_DO2VARIABLE:
     .dw PFA_DO2VARIABLE
PFA_DO2VARIABLE:
     savetos
     movw zl, wl
     adiw zl,1
     readflashcell tosl,tosh
     savetos
     movw zl, wl
     adiw zl,2
     readflashcell tosl,tosh
     jmp DO_NEXT