Use vocabulary stack.
This commit is contained in:
@ -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 >$@
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user