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

Collapse flags and length, bump version.

Browse Source
This commit is contained in:
Brad Nelson
2022-01-09 09:17:42 -08:00
parent d676d018cc
commit e6882c05e4
4 changed files with 13 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
ueforth/Makefile
View File

@ -12,7 +12,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
VERSION=7.0.6.11
VERSION=7.0.6.12
STABLE_VERSION=7.0.5.4
REVISION=$(shell git rev-parse HEAD | head -c 20)
REVSHORT=$(shell echo $(REVISION) | head -c 7)

7
ueforth/common/boot.fs
View File

@ -107,13 +107,14 @@
: abs ( n -- +n ) dup 0< if negate then ;
( Dictionary Format )
: >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ;
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
: >length ( xt -- n ) >flags& @ 8 rshift ;
: >link& ( xt -- a ) 2 cells - ; : >link ( xt -- a ) >link& @ ;
: >flags ( xt -- flags ) cell - ;
: >name ( xt -- a n ) dup >length swap >link& over aligned - swap ;
: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
( Postpone - done here so we have ['] and IF )
: immediate? ( xt -- f ) >flags @ 1 and 0= 0= ;
: immediate? ( xt -- f ) >flags 1 and 0= 0= ;
: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
( Stack Convience )

9
ueforth/common/core.h
View File

@ -110,8 +110,8 @@ static cell_t find(const char *name, cell_t len) {
cell_t *pos = **voc;
cell_t clen = CELL_LEN(len);
while (pos) {
if (!(pos[-1] & SMUDGE) && len == pos[-3] &&
same(name, (const char *) &pos[-3 - clen], len)) {
if (!(pos[-1] & SMUDGE) && len == (pos[-1] >> 8) &&
same(name, (const char *) &pos[-2 - clen], len)) {
return (cell_t) pos;
}
pos = (cell_t *) pos[-2]; // Follow link
@ -125,9 +125,8 @@ static void create(const char *name, cell_t length, cell_t flags, void *op) {
char *pos = (char *) g_sys.heap;
for (cell_t n = length; n; --n) { *pos++ = *name++; } // name
g_sys.heap += CELL_LEN(length);
*g_sys.heap++ = length; // length
*g_sys.heap++ = (cell_t) *g_sys.current; // link
*g_sys.heap++ = flags; // flags
*g_sys.heap++ = (length << 8) | flags; // flags & length
*g_sys.current = g_sys.heap;
*g_sys.heap++ = (cell_t) op; // code
}
@ -218,7 +217,7 @@ static void forth_init(int argc, char *argv[], void *heap,
for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys.heap++ = 0; }
forth_run(0);
(*g_sys.current)[-1] = IMMEDIATE; // Make last word ; IMMEDIATE
(*g_sys.current)[-1] |= IMMEDIATE; // Make last word ; IMMEDIATE
g_sys.DOLIT_XT = FIND("DOLIT");
g_sys.DOFLIT_XT = FIND("DOFLIT");
g_sys.DOEXIT_XT = FIND("EXIT");

8
ueforth/common/locals.fs
View File

@ -37,8 +37,8 @@ variable local-op ' local@ local-op !
: do-local ( n -- ) nest-depth @ + cells negate aliteral
local-op @ , ['] local@ local-op ! ;
: scope-create ( a n -- )
dup >r $place align r> , ( name )
scope @ , 1 , ( IMMEDIATE ) here scope ! ( link, flags )
dup >r $place align ( name )
scope @ , r> 8 lshift 1 or , ( IMMEDIATE ) here scope ! ( link, flags&length )
['] scope-clear @ ( docol) ,
nest-depth @ negate aliteral postpone do-local ['] exit ,
1 scope-depth +! 1 nest-depth +!
@ -64,7 +64,7 @@ also forth definitions
recurse (local) ; immediate
( TODO: Hide the words overriden here. )
: ; scope-clear postpone ; ; immediate
: to ( n -- ) ' dup >flags @ if (to) else ['] ! value-bind then ; immediate
: +to ( n -- ) ' dup >flags @ if (+to) else ['] +! value-bind then ; immediate
: to ( n -- ) ' dup >flags if (to) else ['] ! value-bind then ; immediate
: +to ( n -- ) ' dup >flags if (+to) else ['] +! value-bind then ; immediate
only forth definitions