retroforth/example/byte-addressing.retro
crc 9e03717deb normalize names for examples (with a couple of exceptions), closes #38
FossilOrigin-Name: 088675e452ed86a712563c8b2597fe4d47da59bdea0e40becdd1e028a84c47b0
2021-01-24 01:13:04 +00:00

91 lines
2.6 KiB
Forth

# Byte_Addressing
This adds words allowing access to memory at a byte level.
Nga is cell addressed. There's no direct access to memory at a byte
level. To access a specific byte one must fetch a cell, then extract
the individual bytes by masking and shifting. Updating bytes is
similarly annoying. The words here take care of these details.
It was originally developed for RETRO11 by Marc Simpson and has been
updated for RETRO12 by Charles Childers.
## Authors
* 2010, Marc Simpson
* 2011, 2018-2019, Charles Childers
## Functions
+-------------------+--------+----------------------------+
| Function | Stack | Used For |
+===================+========+============================+
| b:to-byte-address | a-a | Return the byte address of |
| | | the first byte in a cell |
+-------------------+--------+----------------------------+
| b:unpack | c-bbbb | Given a byte-packed cell |
| | | on the stack, return the |
| | | bytes it contains |
+-------------------+--------+----------------------------+
| b:pack | bbbb-c | Pack four byes into a cell,|
| | | return the cell on the |
| | | stack |
+-------------------+--------+----------------------------+
| b:fetch | a-b | Fetch a byte |
+-------------------+--------+----------------------------+
| b:store | ba- | Store a byte into memory |
+-------------------+--------+----------------------------+
## Code & Commentary
~~~
{{
'Byte var
:byte-mask (xn-b)
#255 swap #8 * dup
[ n:negate shift and ] dip shift ;
:replace
#0 [ [ [ [ drop @Byte ] dip ] dip ] dip ] case
#1 [ [ [ drop @Byte ] dip ] dip ] case
#2 [ [ drop @Byte ] dip ] case
#3 [ drop @Byte ] case
drop ;
---reveal---
:b:to-byte-address (a-a) #4 * ;
:b:unpack (c-bbbb)
dup #255 and swap
dup #8 shift #255 and swap
dup #16 shift #255 and swap
#24 shift #255 and ;
:b:pack (bbbb-c)
#-24 shift swap
#-16 shift + swap
#-8 shift + swap + ;
:b:fetch (a-b)
#4 /mod swap
#4 /mod
rot + fetch swap byte-mask ;
:b:store (ba-)
swap !Byte
#4 /mod swap [ dup fetch b:unpack ] dip
replace b:pack swap store ;
}}
~~~
## Some Tests
```
&s:length #4 * #0 + b:fetch
&s:length #4 * #1 + b:fetch
&s:length #4 * #2 + b:fetch
&s:length #4 * #3 + b:fetch
```