Inline dictionary words.

ueforth/common/boot.fs

@@ -19,7 +19,6 @@
 ( Dictionary )
 : here ( -- a ) 'sys @ ;
 : allot ( n -- ) 'sys +! ;
-: 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 ;
@@ -68,15 +67,6 @@
 ( Recursion )
 : recurse   current @ @ aliteral ['] execute , ; immediate
 
-( Dictionary Format )
-: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
-: >name-length ( xt -- n ) >flags& 1+ c@ ;
-: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
-: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
-: >link& ( xt -- a ) 2 cells - ;   : >link ( xt -- a ) >link& @ ;
-: >name ( xt -- a n ) dup >name-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= ;
 : postpone ' dup immediate? if , else aliteral ['] , , then ; immediate

ueforth/common/core.h

@@ -16,7 +16,7 @@
 
 #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 FIND(name) find((name), sizeof(name) - 1)
 #define UPPER(ch) (((ch) >= 'a' && (ch) <= 'z') ? ((ch) & 0x5F) : (ch))
 #define CELL_ALIGNED(a) (((cell_t) (a) + CELL_MASK) & ~CELL_MASK)
 #define IMMEDIATE 1
@@ -110,24 +110,23 @@ static cell_t same(const char *a, const char *b, cell_t len) {
 
 static cell_t find(const char *name, cell_t len) {
   for (cell_t ***voc = g_sys.context; *voc; ++voc) {
-    cell_t *pos = **voc;
-    cell_t clen = CELL_LEN(len);
-    while (pos) {
-      if (!(pos[-1] & SMUDGE) && len == ((pos[-1] >> 8) & 0xff) &&
-          same(name, (const char *) &pos[-2 - clen], len)) {
-        return (cell_t) pos;
+    cell_t xt = (cell_t) **voc;
+    while (xt) {
+      if (!(*TOFLAGS(xt) & SMUDGE) && len == *TONAMELEN(xt) &&
+          same(name, TONAME(xt), len)) {
+        return xt;
       }
-      pos = (cell_t *) pos[-2];  // Follow link
+      xt = *TOLINK(xt);
     }
   }
   return 0;
 }
 
 static void finish(void) {
-  if (g_sys.latestxt && !(g_sys.latestxt[-1] >> 16)) {
+  if (g_sys.latestxt && !*TOPARAMS(g_sys.latestxt)) {
     cell_t sz = g_sys.heap - &g_sys.latestxt[1];
     if (sz < 0 || sz > 0xffff) { sz = 0xffff; }
-    g_sys.latestxt[-1] |= (sz << 16);
+    *TOPARAMS(g_sys.latestxt) = sz;
   }
 }
 

ueforth/common/extra.fs

@@ -60,6 +60,17 @@
 : max 2dup < if nip else drop then ;
 : abs ( n -- +n ) dup 0< if negate then ;
 
+: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
+
+( Dictionary Format )
+: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
+: >name-length ( xt -- n ) >flags& 1+ c@ ;
+: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
+: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
+: >link& ( xt -- a ) 2 cells - ;   : >link ( xt -- a ) >link& @ ;
+: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
+: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
+
 : f= ( r r -- f ) f- f0= ;
 : f< ( r r -- f ) f- f0< ;
 : f> ( r r -- f ) fswap f< ;

ueforth/common/extra_opcodes.h

@@ -56,4 +56,12 @@
   Y(blank, memset((void *) *sp, ' ', tos); NIP; DROP) \
   Y(min, 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(aligned, tos = CELL_ALIGNED(tos)) \
+  X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
+  X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
+  X(">size", TOSIZE, tos = TOSIZE(tos)) \
+  X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \
+  X(">link", TOLINK, tos = *TOLINK(tos)) \
+  X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
+  X(">body", TOBODY, tos = (cell_t) TOBODY(tos))

ueforth/common/forth_namespace_tests.fs

@@ -103,15 +103,6 @@ e: check-boot
   out: rp0 
   out: sp0 
   out: postpone 
-  out: >body 
-  out: >name 
-  out: >link 
-  out: >link& 
-  out: >size 
-  out: >params 
-  out: >name-length 
-  out: >flags 
-  out: >flags& 
   out: recurse 
   out: aft 
   out: repeat 
@@ -144,7 +135,6 @@ e: check-boot
   out: c, 
   out: , 
   out: align 
-  out: aligned 
   out: allot 
   out: here 
   out: \ 
@@ -152,6 +142,16 @@ e: check-boot
 ;e
 
 e: check-extra-opcodes
+  out: >body 
+  out: >name 
+  out: >link 
+  out: >link& 
+  out: >size 
+  out: >params 
+  out: >flags 
+
+  out: aligned 
+
   out: abs 
   out: max 
   out: min 

ueforth/common/opcodes.h

@@ -28,13 +28,22 @@ typedef uintptr_t ucell_t;
 #define DUP (*++sp = tos)
 #define PUSH DUP; tos = (cell_t)
 #define COMMA(n) *g_sys.heap++ = (n)
-#define DOIMMEDIATE() (*g_sys.current)[-1] |= IMMEDIATE
-#define UNSMUDGE() (*g_sys.current)[-1] &= ~SMUDGE; finish()
 #define DOES(ip) **g_sys.current = (cell_t) ADDR_DODOES; (*g_sys.current)[1] = (cell_t) ip
 
 #define PARK   DUP; *++rp = (cell_t) fp; *++rp = (cell_t) sp; *++rp = (cell_t) ip
 #define UNPARK ip = (cell_t *) *rp--;  sp = (cell_t *) *rp--; fp = (float *) *rp--; DROP
 
+#define TOFLAGS(xt) ((uint8_t *) (((cell_t *) (xt)) - 1))
+#define TONAMELEN(xt) (TOFLAGS(xt) + 1)
+#define TOPARAMS(xt) ((uint16_t *) (TOFLAGS(xt) + 2))
+#define TOSIZE(xt) (CELL_ALIGNED(*TONAMELEN(xt)) + sizeof(cell_t) * (3 + *TOPARAMS(xt)))
+#define TOLINK(xt) (((cell_t *) (xt)) - 2)
+#define TONAME(xt) (((char *) TOLINK(xt)) - CELL_ALIGNED(*TONAMELEN(xt)))
+#define TOBODY(xt) (((cell_t *) xt) + ((void *) *((cell_t *) xt) == ADDR_DOCOLON ? 1 : 2))
+
+#define DOIMMEDIATE() *TOFLAGS(*g_sys.current) |= IMMEDIATE
+#define UNSMUDGE() *TOFLAGS(*g_sys.current) &= ~SMUDGE; finish()
+
 #ifndef SSMOD_FUNC
 # if __SIZEOF_POINTER__ == 8
 typedef __int128_t dcell_t;