Reduced default heap use, added better compat logic, testing.

ueforth/common/all_tests.fs

@@ -21,4 +21,5 @@ include common/locals_tests.fs
 include common/doloop_tests.fs
 include common/conditionals_tests.fs
 include common/float_tests.fs
+include common/filetools_tests.fs
 run-tests

ueforth/common/filetools.fs

@@ -20,11 +20,17 @@
 
 internals definitions
 ( Leave some room for growth of starting system. )
-$8000 constant growth-gap
-here growth-gap + growth-gap 1- + growth-gap 1- invert and constant saving-base
+15000 constant compat-level
+0 value saving-base
 : park-heap ( -- a ) saving-base ;
 : park-forth ( -- a ) saving-base cell+ ;
-: 'cold ( -- a ) saving-base 2 cells + ;   0 'cold !
+: 'cold ( -- a ) saving-base 2 cells + ;
+: real-heap-start ( -- a ) sp0 'stack-cells @ cells + ;
+: setup-saving-base
+  here real-heap-start - compat-level cells max
+  real-heap-start + to saving-base
+  saving-base 16 cells + 'heap !
+  0 'cold ! ;
 
 : save-name
   'heap @ park-heap !

ueforth/common/filetools_tests.fs

@@ -0,0 +1,20 @@
+\ Copyright 2021 Bradley D. Nelson
+\
+\ Licensed under the Apache License, Version 2.0 (the "License");
+\ you may not use this file except in compliance with the License.
+\ You may obtain a copy of the License at
+\
+\     http://www.apache.org/licenses/LICENSE-2.0
+\
+\ Unless required by applicable law or agreed to in writing, software
+\ distributed under the License is distributed on an "AS IS" BASIS,
+\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+\ See the License for the specific language governing permissions and
+\ limitations under the License.
+
+( Test if we've exhaused compat threshold )
+internals
+: test-compat-level-exhausted
+  saving-base real-heap-start - compat-level cells =assert
+;
+forth

ueforth/common/fini.fs

@@ -16,7 +16,7 @@ internals
 ( Bring a forth to the top of the vocabulary. )
 transfer forth
 ( Move heap to save point, with a gap. )
-saving-base 16 cells + 'heap !
+setup-saving-base
 forth
 execute ( assumes an xt for autoboot is on the dstack )
 ok

ueforth/common/testing.fs

@@ -44,6 +44,14 @@ variable confirm-old-type
 : expect-finish   expected resulted str= if exit then }confirm
    cr ." Expected:" cr expected type cr ." Resulted:" cr resulted type cr 1 throw ;
 
+( Better error asserts )
+: =assert ( actual expected -- )
+  2dup <> if }confirm ."   FAILURE! EXPECTED: " .
+                      ." ACTUAL: " . space 0 assert then 2drop ;
+: <assert ( actual expected -- )
+  2dup >= if }confirm ."   MUST BE LESS THAN: " .
+                      ." ACTUAL: " . space 0 assert then 2drop ;
+
 ( Input testing )
 create in-buffer 1000 allot
 variable in-head   variable in-tail

ueforth/common/utils.fs

@@ -24,13 +24,12 @@
 ( Remove from Dictionary )
 : forget ( "name" ) ' dup >link current @ !  >name drop here - allot ;
 
-2 constant SMUDGE
-: :noname ( -- xt ) 0 , current @ @ , SMUDGE , here dup current @ ! ['] = @ , postpone ] ;
-
 internals definitions
+2 constant SMUDGE
 : 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
+: :noname ( -- xt ) 0 , current @ @ , SMUDGE , here dup current @ ! ['] = @ , postpone ] ;
 : 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= ;
 : .s   ." <" depth n. ." > " raw.s cr ;

ueforth/posix/web_interface.fs

@@ -110,7 +110,7 @@ window.onload = function() {
 | constant index-html# constant index-html
 
 variable webserver
-20000 constant out-size
+2000 constant out-size
 200 stream input-stream
 out-size stream output-stream
 create out-string out-size 1+ allot align