Fixed alignment issue with locals and casing bug.
This commit is contained in:
@ -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
|
||||
|
||||
@ -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 )
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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 @ , ;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user