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

Inline dictionary words.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-05 21:35:11 -08:00
parent 909353c3d9
commit de7a57e53d
5 changed files with 18 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
ueforth/common/boot.fs
View File

@ -16,13 +16,6 @@
: \ 10 parse drop drop ; immediate : \ 10 parse drop drop ; immediate
( Now can do comments! ) ( Now can do comments! )
( Dictionary )
: here ( -- a ) 'sys @ ;
: allot ( n -- ) 'sys +! ;
: align here aligned here - allot ;
: , ( n -- ) here ! cell allot ;
: c, ( ch -- ) here c! 1 allot ;
( Constants and Variables ) ( Constants and Variables )
: constant ( n "name" -- ) create , does> @ ; : constant ( n "name" -- ) create , does> @ ;
: variable ( "name" -- ) create 0 , ; : variable ( "name" -- ) create 0 , ;

2
ueforth/common/core.h
View File

@ -18,7 +18,7 @@
#define CELL_LEN(n) (((n) + CELL_MASK) / sizeof(cell_t)) #define CELL_LEN(n) (((n) + CELL_MASK) / sizeof(cell_t))
#define FIND(name) find((name), sizeof(name) - 1) #define FIND(name) find((name), sizeof(name) - 1)
#define UPPER(ch) (((ch) >= 'a' && (ch) <= 'z') ? ((ch) & 0x5F) : (ch)) #define UPPER(ch) (((ch) >= 'a' && (ch) <= 'z') ? ((ch) & 0x5F) : (ch))
#define CELL_ALIGNED(a) (((cell_t) (a) + CELL_MASK) & ~CELL_MASK) #define CELL_ALIGNED(a) ((((cell_t) (a)) + CELL_MASK) & ~CELL_MASK)
#define IMMEDIATE 1 #define IMMEDIATE 1
#define SMUDGE 2 #define SMUDGE 2

6
ueforth/common/extra.fs
View File

@ -60,7 +60,13 @@
: max 2dup < if nip else drop then ; : max 2dup < if nip else drop then ;
: abs ( n -- +n ) dup 0< if negate then ; : abs ( n -- +n ) dup 0< if negate then ;
( Dictionary )
: here ( -- a ) 'sys @ ;
: allot ( n -- ) 'sys +! ;
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ; : aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
: align here aligned here - allot ;
: , ( n -- ) here ! cell allot ;
: c, ( ch -- ) here c! 1 allot ;
( Dictionary Format ) ( Dictionary Format )
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ; : >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;

6
ueforth/common/extra_opcodes.h
View File

@ -57,7 +57,13 @@
Y(min, tos = tos < *sp ? tos : *sp; NIP) \ Y(min, tos = tos < *sp ? tos : *sp; NIP) \
Y(max, tos = tos > *sp ? tos : *sp; NIP) \ Y(max, tos = tos > *sp ? tos : *sp; NIP) \
Y(abs, tos = tos < 0 ? -tos : tos) \ Y(abs, tos = tos < 0 ? -tos : tos) \
Y(here, DUP; tos = (cell_t) g_sys.heap) \
Y(allot, g_sys.heap = (cell_t *) (tos + (cell_t) g_sys.heap); DROP) \
Y(aligned, tos = CELL_ALIGNED(tos)) \ Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap)) \
X(",", COMMA, *g_sys.heap++ = tos; DROP) \
X("c,", CCOMMA, *((uint8_t *) g_sys.heap) = tos; DROP; \
g_sys.heap = (cell_t *) (1 + ((cell_t) g_sys.heap))) \
X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \ X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \ X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
X(">size", TOSIZE, tos = TOSIZE(tos)) \ X(">size", TOSIZE, tos = TOSIZE(tos)) \

10
ueforth/common/forth_namespace_tests.fs
View File

@ -132,11 +132,6 @@ e: check-boot
out: current out: current
out: variable out: variable
out: constant out: constant
out: c,
out: ,
out: align
out: allot
out: here
out: \ out: \
out: ( out: (
;e ;e
@ -150,7 +145,12 @@ e: check-extra-opcodes
out: >params out: >params
out: >flags out: >flags
out: c,
out: ,
out: align
out: aligned out: aligned
out: allot
out: here
out: abs out: abs
out: max out: max