Use vocabulary stack.

This commit is contained in:
Brad Nelson
2021-02-06 23:32:53 -08:00
parent bbf5840691
commit 560264677a
4 changed files with 25 additions and 20 deletions

View File

@ -115,25 +115,23 @@ $(GEN):
POSIX_BOOT = common/boot.fs common/vocabulary.fs common/hide_calls.fs common/ansi.fs \
posix/posix.fs posix/posix_highlevel.fs \
common/highlevel.fs common/filetools.fs posix/posix_desktop.fs \
common/tasks.fs common/streams.fs common/blocks.fs posix/args.fs \
common/utils.fs
common/utils.fs common/highlevel.fs common/filetools.fs posix/posix_desktop.fs \
common/tasks.fs common/streams.fs common/blocks.fs posix/args.fs
$(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
echo "ok" | cat $(POSIX_BOOT) - | $< boot >$@
WINDOWS_BOOT = common/boot.fs common/vocabulary.fs common/hide_calls.fs common/ansi.fs \
windows/windows.fs windows/windows_highlevel.fs common/highlevel.fs \
common/tasks.fs common/streams.fs common/blocks.fs \
common/utils.fs
common/utils.fs common/tasks.fs common/streams.fs common/blocks.fs
$(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN)
echo "ok" | cat $(WINDOWS_BOOT) - | $< boot >$@
ARDUINO_BOOT = common/boot.fs common/vocabulary.fs \
arduino/arduino.fs arduino/arduino_highlevel.fs \
arduino/hide_io.fs \
common/highlevel.fs common/filetools.fs \
arduino/hide_io.fs common/highlevel.fs \
common/filetools.fs common/utils.fs \
common/tasks.fs common/streams.fs arduino/arduino_server.fs \
arduino/esp_camera.fs common/blocks.fs common/utils.fs \
arduino/esp_camera.fs common/blocks.fs \
arduino/autoboot.fs
$(GEN)/arduino_boot.h: common/source_to_string.js $(ARDUINO_BOOT) | $(GEN)
echo "ok" | cat $(ARDUINO_BOOT) - | $< boot >$@

View File

@ -1,9 +1,4 @@
( Utilities, probably should go elsewhere )
: mem= ( a a n -- f)
for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
: str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ;
: startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ;
: assert ( f -- ) 0= throw ;
also ansi also posix
( Support for eval tests )
1000 constant expect-limit
@ -45,9 +40,7 @@ variable tests-found variable tests-run variable tests-passed
: check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then ;
: wrap-test ( xt -- ) expect-reset >r check-fresh r> execute check-fresh expect-finish ;
: red 1 fg ; : green 2 fg ; : hr 40 for [char] - emit next cr ;
ansi
: replace-line 13 emit clear-to-eol ;
forth
: label-test ( xt -- ) replace-line >name type ;
: run-test ( xt -- ) dup label-test confirm{ ['] wrap-test catch }confirm
if drop ( cause xt restored on throw ) red ." FAILED" normal cr
@ -62,9 +55,8 @@ forth
else
." FAILED: " red tests-run @ tests-passed @ - . normal cr
then hr ;
posix
: run-tests
reset-test-counters ['] count-test for-tests
['] run-test for-tests show-test-results
tests-passed @ tests-found @ <> sysexit ;
forth
only forth

View File

@ -2,4 +2,13 @@
: .s ." <" depth <# #s #> type ." > "
depth 0 max for aft sp@ r@ cells - @ . then next cr ;
: assert ( f -- ) 0= throw ;
internals definitions
: mem= ( a a n -- f)
for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
forth definitions also internals
: str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ;
: startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ;
only forth definitions

View File

@ -13,12 +13,18 @@
: }transfer ;
: transfer{ begin ' dup ['] }transfer = if drop exit then transfer-xt again ;
( Watered down versions of these )
: only forth 0 context cell+ ! ;
: last-voc ( -- a) context begin dup @ while cell+ repeat ;
: also context context cell+ last-voc over - cell+ cmove> ;
: sealed 0 current @ ! ;
( Hide some words in an internals vocabulary )
vocabulary internals internals definitions
transfer{
transfer-xt
transfer-xt last-voc
branch 0branch donext dolit
'notfound notfound
'context 'notfound notfound
immediate? input-buffer ?echo ?echo-prompt
evaluate1 evaluate-buffer
'sys 'heap aliteral