diff --git a/ueforth/common/base_tests.fs b/ueforth/common/base_tests.fs index 3e23b3f..552bbdd 100644 --- a/ueforth/common/base_tests.fs +++ b/ueforth/common/base_tests.fs @@ -112,3 +112,8 @@ e: test-key key 49 = assert key nl = assert ;e + +e: test-compiler-off + : test [ 123 111 + literal ] ; + test 234 = assert +;e diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs index 32eaca9..27797cc 100644 --- a/ueforth/common/boot.fs +++ b/ueforth/common/boot.fs @@ -193,15 +193,16 @@ variable hld ( Strings ) : parse-quote ( -- a n ) [char] " parse ; -: $place ( a n -- ) for aft dup c@ c, 1+ then next drop 0 c, align ; +: $place ( a n -- ) for aft dup c@ c, 1+ then next drop ; +: zplace ( a n -- ) $place 0 c, align ; : $@ r@ dup cell+ swap @ r> dup @ 1+ aligned + cell+ >r ; -: s" parse-quote state @ if postpone $@ dup , $place - else dup here swap >r >r $place r> r> then ; immediate +: s" parse-quote state @ if postpone $@ dup , zplace + else dup here swap >r >r zplace r> r> then ; immediate : ." postpone s" state @ if postpone type else type then ; immediate : z" postpone s" state @ if postpone drop else drop then ; immediate : r" parse-quote state @ if swap aliteral aliteral then ; immediate : r| [char] | parse state @ if swap aliteral aliteral then ; immediate -: s>z ( a n -- z ) here >r $place r> ; +: s>z ( a n -- z ) here >r zplace r> ; : z>s ( z -- a n ) 0 over begin dup c@ while 1+ swap 1+ swap repeat drop ; ( Fill, Move ) diff --git a/ueforth/common/core.h b/ueforth/common/core.h index e301355..f1c3bd2 100644 --- a/ueforth/common/core.h +++ b/ueforth/common/core.h @@ -14,9 +14,11 @@ #define PRINT_ERRORS 0 -#define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t)) +#define CELL_MASK (sizeof(cell_t) - 1) +#define CELL_LEN(n) (((n) + CELL_MASK) / sizeof(cell_t)) #define FIND(name) find(name, sizeof(name) - 1) -#define LOWER(ch) ((ch) & 0x5F) +#define UPPER(ch) (((ch) >= 'a' && (ch) <= 'z') ? ((ch) & 0x5F) : (ch)) +#define CELL_ALIGNED(a) (((cell_t) (a) + CELL_MASK) & ~CELL_MASK) #define IMMEDIATE 1 #define SMUDGE 2 #define VOCABULARY_DEPTH 16 @@ -44,9 +46,9 @@ static cell_t convert(const char *pos, cell_t n, cell_t *ret) { if (pos[0] == '-') { negate = -1; ++pos; --n; } if (pos[0] == '$') { base = 16; ++pos; --n; } for (; n; --n) { - uintptr_t d = pos[0] - '0'; + uintptr_t d = UPPER(pos[0]) - '0'; if (d > 9) { - d = LOWER(d) - 7; + d -= 7; if (d < 10) { return 0; } } if (d >= base) { return 0; } @@ -58,8 +60,8 @@ static cell_t convert(const char *pos, cell_t n, cell_t *ret) { } static cell_t same(const char *a, const char *b, cell_t len) { - for (;len && LOWER(*a) == LOWER(*b); --len, ++a, ++b); - return len; + for (;len && UPPER(*a) == UPPER(*b); --len, ++a, ++b); + return len == 0; } static cell_t find(const char *name, cell_t len) { @@ -68,7 +70,7 @@ static cell_t find(const char *name, cell_t len) { cell_t clen = CELL_LEN(len); while (pos) { if (!(pos[-1] & SMUDGE) && len == pos[-3] && - same(name, (const char *) &pos[-3 - clen], len) == 0) { + same(name, (const char *) &pos[-3 - clen], len)) { return (cell_t) pos; } pos = (cell_t *) pos[-2]; // Follow link @@ -78,6 +80,7 @@ static cell_t find(const char *name, cell_t len) { } static void create(const char *name, cell_t length, cell_t flags, void *op) { + g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap); char *pos = (char *) g_sys.heap; for (cell_t n = length; n; --n) { *pos++ = *name++; } // name g_sys.heap += CELL_LEN(length); diff --git a/ueforth/common/locals.fs b/ueforth/common/locals.fs index 1e9a6e7..5ffc626 100644 --- a/ueforth/common/locals.fs +++ b/ueforth/common/locals.fs @@ -25,7 +25,7 @@ scope-doer scope-template begin scope-depth @ while postpone rdrop cell scope-depth +! repeat 0 scope ! ; : scope-create ( a n -- ) - dup >r $place r> , ( name ) + dup >r $place align r> , ( name ) scope @ , 0 , here scope ! ( link, flags ) ['] scope-template dup @ , cell+ @ , cell negate scope-depth +! scope-depth @ , ; diff --git a/ueforth/common/locals_tests.fs b/ueforth/common/locals_tests.fs index da95b2b..3cc035d 100644 --- a/ueforth/common/locals_tests.fs +++ b/ueforth/common/locals_tests.fs @@ -26,3 +26,13 @@ e: test-locals-two sp0 sp! ;e +e: test-alignment + 30 allot + : color24 { r g b } r 16 lshift g 8 lshift b or or ; + 1 2 3 color24 66051 = assert +;e + +e: test-longname + : setPixelColor { pixelNum } pixelNum ; + 1 setPixelColor 1 = assert +;e diff --git a/ueforth/web/web.template.js b/ueforth/web/web.template.js index 32fa0f7..6bd3c6b 100644 --- a/ueforth/web/web.template.js +++ b/ueforth/web/web.template.js @@ -65,12 +65,17 @@ function Load(addr, content) { return addr; } +function UPPER(a) { + // a = 97, z = 122 + return a >= 97 && a <= 122 ? a & 95 : a; +} + function Same(a, b) { if (a.length != b.length) { return false; } for (var i = 0; i < a.length; ++i) { - if ((a.charCodeAt(i) & 95) != (b.charCodeAt(i) & 95)) { + if (UPPER(a.charCodeAt(i)) != UPPER(b.charCodeAt(i))) { return false; } }