rendered paste body
\ ==========================================================
\ 16-bit address access; fetching & storing.
\ (Adapted from Ertl's 64-bit / 32-bit code on Usenet.)
\ ==========================================================
: binary 2 base ! ;
: bin. base @ swap binary u. base ! ;
: w@ ( addr -- n ) \ 16 bit fetch
dup dup aligned = if
@ $0000ffff and
else
2 - @ $10 rshift
then ;
: w! ( n addr -- ) \ 16 bit store
dup dup aligned = if
dup @ $ffff0000 and
rot or
swap !
else
2 - dup @
$0000ffff and
rot $10 lshift or
swap !
then ;
: shorts 2* chars ;
: short+ 1 shorts + ;
: w.
dup $1000 and if
." -" invert $0000ffff and 1+ then
u. ;
\ ---[ Testing ]--------------------------------------------
false [if]
: grab here 1 shorts allot ;
: test grab swap over w! w@ ;
: test. test bin. ;
[then]