mirror of
https://git.sr.ht/~crc_/retroforth
synced 2024-11-16 19:48:56 +01:00
65b18e870a
FossilOrigin-Name: e0c3be78d02a5b5bf6fda5557f283f65c81cc249d4fb0fcab9b83e7643f138ed
29 lines
860 B
Forth
29 lines
860 B
Forth
The related ilo & napia virtual machines make use of blocks
|
|
for data storage. This implements a set of words for interacting
|
|
with the blocks from within RetroForth/Nga.
|
|
|
|
The exposed word set is compact:
|
|
|
|
block:set-file (s-)
|
|
block:read (na-)
|
|
block:write (na-)
|
|
|
|
~~~
|
|
{{
|
|
'Blocks var
|
|
'BlockFile var
|
|
|
|
:open (n-) @BlockFile swap file:open !Blocks ;
|
|
:close (-) @Blocks file:close ;
|
|
:seek (n-) #4096 n:mul @Blocks file:seek ;
|
|
:read (-n) #4 [ @Blocks file:read ] times pack ;
|
|
:store (an-a) swap store-next ;
|
|
:write (n-) unpack 'abcd 'bcda reorder #4 [ dup n:put sp @Blocks file:write ] times ;
|
|
---reveal---
|
|
:block:set-file (s-) s:keep !BlockFile ;
|
|
:block:read (na-)
|
|
file:R open swap seek #1024 [ read store ] times drop close ;
|
|
:block:write (na-)
|
|
file:R+ open swap seek #1024 [ fetch-next write ] times drop close ;
|
|
}}
|
|
~~~
|