alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Hide more

Browse Source
This commit is contained in:
Brad Nelson
2021-02-06 16:40:06 -08:00
parent 1921f3c736
commit cf056a58b6
2 changed files with 15 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
ueforth/common/blocks.fs
View File

@ -2,17 +2,19 @@
internals definitions internals definitions
: clobber-line ( a -- a' ) dup 63 bl fill 63 + nl over c! 1+ ; : clobber-line ( a -- a' ) dup 63 bl fill 63 + nl over c! 1+ ;
: clobber ( a -- ) 15 for clobber-line next drop ; : clobber ( a -- ) 15 for clobber-line next drop ;
0 value block-dirty
create block-data 1024 allot
forth definitions internals forth definitions internals
-1 value block-fid variable scr -1 value block-id 0 value block-dirty -1 value block-fid variable scr -1 value block-id
create block-data 1024 allot
: open-blocks ( a n -- ) : open-blocks ( a n -- )
block-fid 0< 0= if block-fid close-file throw -1 to block-fid then block-fid 0< 0= if block-fid close-file throw -1 to block-fid then
2dup r/w open-file if drop r/w create-file throw else nip nip then to block-fid ; 2dup r/w open-file if drop r/w create-file throw else nip nip then to block-fid ;
: use ( "name" -- ) bl parse open-blocks ; : use ( "name" -- ) bl parse open-blocks ;
defer default-use
internals definitions internals definitions
: common-default-use s" blocks.fb" open-blocks ; : common-default-use s" blocks.fb" open-blocks ;
defer default-use ' common-default-use is default-use ' common-default-use is default-use
: use?! block-fid 0< if default-use then ; : use?! block-fid 0< if default-use then ;
: grow-blocks ( n -- ) 1024 * block-fid file-size throw max block-fid resize-file throw ; : grow-blocks ( n -- ) 1024 * block-fid file-size throw max block-fid resize-file throw ;
forth definitions internals forth definitions internals

27
ueforth/common/vocabulary.fs
View File

@ -10,28 +10,21 @@
( Hide some words in an internals vocabulary ) ( Hide some words in an internals vocabulary )
vocabulary internals internals definitions vocabulary internals internals definitions
transfer branch transfer branch transfer 0branch transfer donext transfer dolit
transfer 0branch transfer 'notfound transfer notfound
transfer 'notfound
transfer notfound
transfer immediate? transfer immediate?
transfer evaluate1 transfer input-buffer transfer ?echo transfer ?echo-prompt
transfer 'sys transfer evaluate1 transfer evaluate-buffer
transfer 'heap transfer 'sys transfer 'heap
transfer aliteral transfer aliteral
transfer leaving( transfer leaving( transfer )leaving transfer leaving transfer leaving,
transfer )leaving transfer (do) transfer (?do) transfer (+loop)
transfer leaving
transfer leaving,
transfer (do)
transfer (?do)
transfer (+loop)
transfer parse-quote transfer parse-quote
transfer digit transfer digit
transfer $@ transfer $@
transfer see. transfer see. transfer see-loop transfer >name-length transfer exit=
transfer see-loop transfer see-one
transfer >name-length transfer tib-setup transfer input-limit
transfer call0 transfer call1 transfer call2 transfer call3 transfer call4 transfer call0 transfer call1 transfer call2 transfer call3 transfer call4
transfer call5 transfer call6 transfer call7 transfer call8 transfer call9 transfer call5 transfer call6 transfer call7 transfer call8 transfer call9
transfer call10 transfer call10