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

Fix web-interface lazy loading.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-02 10:03:49 -08:00
parent 8e40e7d7d9
commit 2dd9e33928
2 changed files with 26 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/common/forth_namespace_tests.fs
View File

@ -13,7 +13,7 @@
\ limitations under the License. \ limitations under the License.
also internals also internals
: list-from ( xt ) begin dup >name-length while dup see. cr >link repeat drop ; : list-from ( xt ) begin dup nonvoc? while dup see. cr >link repeat drop ;
e: check-locals e: check-locals
out: +to out: +to
@ -463,6 +463,7 @@ e: test-posix-forth-namespace
e: test-posix-forth-namespace e: test-posix-forth-namespace
' forth list-from ' forth list-from
out: FORTH out: FORTH
out:
out: web-interface out: web-interface
out: httpd out: httpd
out: telnetd out: telnetd
@ -550,6 +551,8 @@ e: test-esp32-forth-namespace
out: registers out: registers
out: webui out: webui
out: login out: login
out:
out:
out: web-interface out: web-interface
out: httpd out: httpd
out: oled out: oled

27
ueforth/common/utils.fs
View File

@ -26,10 +26,12 @@
internals definitions internals definitions
2 constant SMUDGE 2 constant SMUDGE
8 constant NONAMED
: mem= ( a a n -- f) : mem= ( a a n -- f)
for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ; for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
forth definitions also internals forth definitions also internals
: :noname ( -- xt ) 0 , current @ @ , SMUDGE , here dup current @ ! ['] = @ , postpone ] ; : :noname ( -- xt ) 0 , current @ @ , NONAMED SMUDGE or ,
here dup current @ ! ['] = @ , postpone ] ;
: str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ; : 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= ; : startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ;
: .s ." <" depth n. ." > " raw.s cr ; : .s ." <" depth n. ." > " raw.s cr ;
@ -56,8 +58,10 @@ internals definitions
dup @ ['] see-loop @ <> dup @ ['] see-loop @ <>
if ." Unsupported word type: " see. cr exit then if ." Unsupported word type: " see. cr exit then
['] : see. dup see. space see-loop ['] ; see. cr ; ['] : see. dup see. space see-loop ['] ; see. cr ;
: >name-length ( xt -- n ) dup 0= if exit then >name nip ; : nonvoc? ( xt -- f )
: see-vocabulary ( voc ) @ begin dup >name-length while dup see-xt >link repeat drop cr ; dup 0= if exit then dup >name nip swap >flags NONAMED and or ;
: see-vocabulary ( voc )
@ begin dup nonvoc? while dup see-xt >link repeat drop cr ;
: >vocnext ( xt -- xt ) >body 2 cells + @ ; : >vocnext ( xt -- xt ) >body 2 cells + @ ;
: see-all : see-all
last-vocabulary @ begin dup while last-vocabulary @ begin dup while
@ -68,9 +72,22 @@ internals definitions
: voclist last-vocabulary @ begin dup while dup see. cr >vocnext repeat drop ; : voclist last-vocabulary @ begin dup while dup see. cr >vocnext repeat drop ;
: voc. ( voc -- ) 2 cells - see. ; : voc. ( voc -- ) 2 cells - see. ;
: vocs. ( voc -- ) dup voc. @ begin dup while : vocs. ( voc -- ) dup voc. @ begin dup while
dup >name-length 0= if ." >> " dup 2 cells - voc. then dup nonvoc? 0= if ." >> " dup 2 cells - voc. then
>link >link
repeat drop cr ; repeat drop cr ;
( Words to measure size of things )
: size-vocabulary ( voc )
@ begin dup nonvoc? while
dup see. dup dup >link - . >link
repeat drop cr ;
: size-all
last-vocabulary @ begin dup while
." VOCABULARY " dup see. cr ." ------------------------" cr
dup >body size-vocabulary
>vocnext
repeat drop cr ;
forth definitions also internals forth definitions also internals
: see ' see-xt ; : see ' see-xt ;
: order context begin dup @ while dup @ vocs. cell+ repeat drop ; : order context begin dup @ while dup @ vocs. cell+ repeat drop ;
@ -82,7 +99,7 @@ internals definitions
: onlines ( n xt -- n xt ) : onlines ( n xt -- n xt )
swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ; swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ;
forth definitions also internals forth definitions also internals
: vlist 0 context @ @ begin dup >name-length while onlines dup see. >link repeat 2drop cr ; : vlist 0 context @ @ begin dup nonvoc? while onlines dup see. >link repeat 2drop cr ;
: words 0 context @ @ begin dup while onlines dup see. >link repeat 2drop cr ; : words 0 context @ @ begin dup while onlines dup see. >link repeat 2drop cr ;
only forth definitions only forth definitions