add many more words

diff --git a/README.md b/README.md
index 91d2a9d4b28515142799e08566282f801a37dfb9..4e2223b706ab647f1499ca15221a56977f7b5cbd 100644 (file)
--- a/README.md
+++ b/README.md
@@ -8,12 +8,11 @@ Register usage is the only platform-specific requirement; otherwise, `foci` is w
 
 ## Available words
 
 
 ## Available words
 

-```
-dup drop swap rot -rot over tuck @ ! c@ c! + +! - * / mod and or xor = < [ ] ,
-cell cell+ cells base here allot latest negate invert 1- 1+ aligned align : ;
-literal if then else ' ['] execute decimal hex . emit begin until again while
-repeat >r r> 2>r 2r> r@ do loop i immediate
-```
+Many words from [core ANS Forth](https://forth-standard.org/standard/core) are supported. See `compat.txt` for a list.
+
+Some features are not expected to be implemented:
+* Pictured numeric output, e.g. `<# # #>`
+* Double-width arithmetic

 
 ## Build instructions
 
 
 ## Build instructions
 

diff --git a/compat.txt b/compat.txt
new file mode 100644 (file)
index 0000000..8429d5b
--- /dev/null
+++ b/compat.txt
@@ -0,0 +1,133 @@
+yes 6.1.0010 !
+    6.1.0030 #
+    6.1.0040 #>
+    6.1.0050 #S
+yes 6.1.0070 '
+    6.1.0080 (
+yes 6.1.0090 *
+    6.1.0100 */
+    6.1.0110 */MOD
+yes 6.1.0120 +
+yes 6.1.0130 +!
+    6.1.0140 +LOOP
+yes 6.1.0150 ,
+yes 6.1.0160 -
+yes 6.1.0180 .
+    6.1.0190 ."
+yes 6.1.0230 /
+    6.1.0240 /MOD
+yes 6.1.0250 0<
+yes 6.1.0270 0=
+yes 6.1.0290 1+
+yes 6.1.0300 1-
+yes 6.1.0310 2!
+yes 6.1.0320 2*
+    6.1.0330 2/
+yes 6.1.0350 2@
+yes 6.1.0370 2DROP
+yes 6.1.0380 2DUP
+    6.1.0400 2OVER
+    6.1.0430 2SWAP
+yes 6.1.0450 :
+yes 6.1.0460 ;
+yes 6.1.0480 <
+    6.1.0490 <#
+yes 6.1.0530 =
+yes 6.1.0540 >
+    6.1.0550 >BODY
+    6.1.0560 >IN
+    6.1.0570 >NUMBER
+yes 6.1.0580 >R
+    6.1.0630 ?DUP
+yes 6.1.0650 @
+    6.1.0670 ABORT
+    6.1.0680 ABORT"
+    6.1.0690 ABS
+    6.1.0695 ACCEPT
+yes 6.1.0705 ALIGN
+yes 6.1.0706 ALIGNED
+yes 6.1.0710 ALLOT
+yes 6.1.0720 AND
+yes 6.1.0750 BASE
+yes 6.1.0760 BEGIN
+yes 6.1.0770 BL
+yes 6.1.0850 C!
+yes 6.1.0860 C,
+yes 6.1.0870 C@
+yes 6.1.0880 CELL+
+yes 6.1.0890 CELLS
+    6.1.0895 CHAR
+yes 6.1.0897 CHAR+
+yes 6.1.0898 CHARS
+    6.1.0950 CONSTANT
+    6.1.0980 COUNT
+yes 6.1.0990 CR
+    6.1.1000 CREATE
+yes 6.1.1170 DECIMAL
+yes 6.1.1200 DEPTH
+yes 6.1.1240 DO
+    6.1.1250 DOES>
+yes 6.1.1260 DROP
+yes 6.1.1290 DUP
+yes 6.1.1310 ELSE
+yes 6.1.1320 EMIT
+    6.1.1345 ENVIRONMENT?
+    6.1.1360 EVALUATE
+yes 6.1.1370 EXECUTE
+    6.1.1380 EXIT
+    6.1.1540 FILL
+    6.1.1550 FIND
+    6.1.1561 FM/MOD
+yes 6.1.1650 HERE
+    6.1.1670 HOLD
+yes 6.1.1680 I
+yes 6.1.1700 IF
+yes 6.1.1710 IMMEDIATE
+yes 6.1.1720 INVERT
+    6.1.1730 J
+    6.1.1750 KEY
+    6.1.1760 LEAVE
+yes 6.1.1780 LITERAL
+yes 6.1.1800 LOOP
+    6.1.1805 LSHIFT
+    6.1.1810 M*
+    6.1.1870 MAX
+    6.1.1880 MIN
+yes 6.1.1890 MOD
+    6.1.1900 MOVE
+yes 6.1.1910 NEGATE
+yes 6.1.1980 OR
+yes 6.1.1990 OVER
+    6.1.2033 POSTPONE
+    6.1.2050 QUIT
+yes 6.1.2060 R>
+yes 6.1.2070 R@
+yes 6.1.2120 RECURSE
+yes 6.1.2140 REPEAT
+yes 6.1.2160 ROT
+    6.1.2162 RSHIFT
+    6.1.2165 S"
+    6.1.2170 S>D
+    6.1.2210 SIGN
+    6.1.2214 SM/REM
+    6.1.2216 SOURCE
+yes 6.1.2220 SPACE
+    6.1.2230 SPACES
+yes 6.1.2250 STATE
+yes 6.1.2260 SWAP
+yes 6.1.2270 THEN
+    6.1.2310 TYPE
+    6.1.2320 U.
+    6.1.2340 U<
+    6.1.2360 UM*
+    6.1.2370 UM/MOD
+    6.1.2380 UNLOOP
+yes 6.1.2390 UNTIL
+    6.1.2410 VARIABLE
+yes 6.1.2430 WHILE
+    6.1.2450 WORD
+yes 6.1.2490 XOR
+yes 6.1.2500 [
+yes 6.1.2510 [']
+    6.1.2520 [CHAR]
+yes 6.1.2540 ]

diff --git a/foci.c b/foci.c
index e7529462100e403ae45b7d8ea6a4e32f510a0e44..6d6c507561d93fcf3670636e3a91bcf2e6d38729 100644 (file)
--- a/foci.c
+++ b/foci.c
@@ -35,7 +35,6 @@ NAKED void  push(void) { *--sp = (intptr_t)*++pp; NEXT; }
 NAKED void fexit(void) { pp = *rp++; NEXT; }
 
 void fend(void) {}
 NAKED void fexit(void) { pp = *rp++; NEXT; }
 
 void fend(void) {}

-static const void * const fend_b[2] = { 0, fend };

 
 NAKED void compname(void)
 {
 
 NAKED void compname(void)
 {


@@ -102,7 +101,9 @@ N(mrot,   "-rot",   &w_rot)   { tmp = sp[2]; sp[2] = sp[0]; sp[0] = sp[1];
                                 sp[1] = tmp; NEXT; }
 N(over,   "over",   &w_mrot)  { --sp; sp[0] = sp[2]; NEXT; }
 W(tuck,   "tuck",   &w_over)  swap, over, END
                                 sp[1] = tmp; NEXT; }
 N(over,   "over",   &w_mrot)  { --sp; sp[0] = sp[2]; NEXT; }
 W(tuck,   "tuck",   &w_over)  swap, over, END

-N(peek,   "@",      &w_tuck)  { *sp = *(intptr_t *)*sp; NEXT; }
+W(drop2,  "2drop",  &w_tuck)  drop, drop, END
+W(dup2,   "2dup",   &w_drop2) over, over, END
+N(peek,   "@",      &w_dup2)  { *sp = *(intptr_t *)*sp; NEXT; }

 N(poke,   "!",      &w_peek)  { *(intptr_t *)sp[0] = sp[1]; sp += 2; NEXT; }
 N(cpeek,  "c@",     &w_poke)  { *sp = *(char *)*sp; NEXT; }
 N(cpoke,  "c!",     &w_cpeek) { *(char *)sp[0] = (char)sp[1]; sp += 2; NEXT; }
 N(poke,   "!",      &w_peek)  { *(intptr_t *)sp[0] = sp[1]; sp += 2; NEXT; }
 N(cpeek,  "c@",     &w_poke)  { *sp = *(char *)*sp; NEXT; }
 N(cpoke,  "c!",     &w_cpeek) { *(char *)sp[0] = (char)sp[1]; sp += 2; NEXT; }


@@ -117,24 +118,32 @@ N(or,     "or",     &w_and)   { sp[1] |= sp[0]; ++sp; NEXT; }
 N(xor,    "xor",    &w_or)    { sp[1] ^= sp[0]; ++sp; NEXT; }
 N(eq,     "=",      &w_xor)   { sp[1] = sp[0] == sp[1] ? -1 : 0; ++sp; NEXT; }
 N(lt,     "<",      &w_eq)    { sp[1] = sp[0] > sp[1] ? -1 : 0; ++sp; NEXT; }
 N(xor,    "xor",    &w_or)    { sp[1] ^= sp[0]; ++sp; NEXT; }
 N(eq,     "=",      &w_xor)   { sp[1] = sp[0] == sp[1] ? -1 : 0; ++sp; NEXT; }
 N(lt,     "<",      &w_eq)    { sp[1] = sp[0] > sp[1] ? -1 : 0; ++sp; NEXT; }

-N(compname, "_c",   &w_lt)    ;
+W(gt,     ">",      &w_lt)    swap, lt, END
+W(zeq,    "0=",     &w_gt)    LIT(0), eq, END
+W(zlt,    "0<",     &w_zeq)   LIT(0), lt, END
+N(compname, "_c",   &w_zlt)   ;

 C(intr,   "[",      &w_compname) { STATE = 0; NEXT; }
 N(comp,   "]",      &w_intr)  { STATE = -1; NEXT; }
 N(comma,  ",",      &w_comp)  { *here++ = *sp++; NEXT; }
 W(cell,   "cell",   &w_comma) LIT(sizeof(*sp)),   END
 W(cellp,  "cell+",  &w_cell)  FTH(cell), add,     END
 W(cells,  "cells",  &w_cellp) FTH(cell), mul,     END
 C(intr,   "[",      &w_compname) { STATE = 0; NEXT; }
 N(comp,   "]",      &w_intr)  { STATE = -1; NEXT; }
 N(comma,  ",",      &w_comp)  { *here++ = *sp++; NEXT; }
 W(cell,   "cell",   &w_comma) LIT(sizeof(*sp)),   END
 W(cellp,  "cell+",  &w_cell)  FTH(cell), add,     END
 W(cells,  "cells",  &w_cellp) FTH(cell), mul,     END

-N(dict,   "_d",     &w_cells) { *--sp = (intptr_t)dictmem; NEXT; }
-W(base,   "base",   &w_dict)  LIT(&BASE), END
+W(charp,  "char+",  &w_cells) LIT(1), add, END
+W(chars,  "chars",  &w_charp) END
+W(base,   "base",   &w_chars) LIT(&BASE), END

 W(here,   "here",   &w_base)  LIT(&here), peek,   END
 W(allot,  "allot",  &w_here)  LIT(&here), FTH(addto), END
 W(here,   "here",   &w_base)  LIT(&here), peek,   END
 W(allot,  "allot",  &w_here)  LIT(&here), FTH(addto), END

-W(latest, "latest", &w_allot) LIT(&LATEST), peek, END
+W(ccomma, "c,",     &w_allot) FTH(here), cpoke, LIT(1), FTH(allot), END
+W(latest, "latest", &w_ccomma) LIT(&LATEST), peek, END

 W(negate, "negate", &w_latest) LIT(-1), mul, END
 W(invert, "invert", &w_negate) LIT(-1), xor, END
 W(negate, "negate", &w_latest) LIT(-1), mul, END
 W(invert, "invert", &w_negate) LIT(-1), xor, END

-W(dec,    "1-",     &w_invert) LIT(1), sub,  END
-W(inc,    "1+",     &w_dec)    LIT(1), add,  END
-W(aligned, "aligned", &w_inc)  LIT(sizeof(*sp) - 1), add, LIT(~(sizeof(*sp) - 1)),
-                               and, END
+W(dec,    "1-",     &w_invert) LIT(1), sub, END
+W(inc,    "1+",     &w_dec)    LIT(1), add, END
+W(twot,   "2*",     &w_inc)    LIT(2), mul, END
+W(peek2,  "2@",     &w_twot)   dup, FTH(cellp), peek, swap, peek, END
+W(poke2,  "2!",     &w_peek2)  swap, over, poke, FTH(cellp), poke, END
+W(aligned, "aligned", &w_poke2) LIT(sizeof(*sp) - 1), add, LIT(~(sizeof(*sp) - 1)),
+                                and, END

 W(align,  "align",  &w_aligned) FTH(here), FTH(aligned), LIT(&here), poke, END
 W(colon,  ":",      &w_align)   FTH(here), LIT(0), comma, FTH(latest), comma,
                                 compname, FTH(allot), FTH(align), dup,
 W(align,  "align",  &w_aligned) FTH(here), FTH(aligned), LIT(&here), poke, END
 W(colon,  ":",      &w_align)   FTH(here), LIT(0), comma, FTH(latest), comma,
                                 compname, FTH(allot), FTH(align), dup,


@@ -149,11 +158,16 @@ I(felse,  "else",   &w_then)    LIT(b), comma, FTH(here), LIT(0), comma, swap, F
 W(tick,   "\'",     &w_felse)   compname, drop, lookup, peek, END
 I(ctick,  "[\']",   &w_tick)    FTH(tick), FTH(literal), END
 N(execute, "execute", &w_ctick) { pp = (intptr_t **)*sp++ - 1; NEXT; }
 W(tick,   "\'",     &w_felse)   compname, drop, lookup, peek, END
 I(ctick,  "[\']",   &w_tick)    FTH(tick), FTH(literal), END
 N(execute, "execute", &w_ctick) { pp = (intptr_t **)*sp++ - 1; NEXT; }

-W(decimal, "decimal", &w_execute) LIT(10), LIT(&BASE), poke, END
+N(recurse, "recurse", &w_execute) { pp = (intptr_t **)**rp - 1; NEXT; }
+W(decimal, "decimal", &w_recurse) LIT(10), LIT(&BASE), poke, END

 W(hex,     "hex",    &w_decimal) LIT(16), LIT(&BASE), poke, END
 N(dot,    ".",      &w_hex)     ;
 N(emit,   "emit",   &w_dot)     { foci_putchar(*sp++); NEXT; }
 W(hex,     "hex",    &w_decimal) LIT(16), LIT(&BASE), poke, END
 N(dot,    ".",      &w_hex)     ;
 N(emit,   "emit",   &w_dot)     { foci_putchar(*sp++); NEXT; }

-I(begin,  "begin",  &w_emit)    FTH(here), LIT(sizeof(intptr_t)), sub, END
+W(bl,     "bl",     &w_emit)    LIT(' '), END
+W(space,  "space",  &w_bl)      LIT(' '), emit, END
+W(cr,     "cr",     &w_space)   LIT('\n'), emit, END
+N(depth,  "depth",  &w_cr)      { *--sp = foci_depth(); NEXT; }
+I(begin,  "begin",  &w_depth)   FTH(here), LIT(sizeof(intptr_t)), sub, END

 I(until,  "until",  &w_begin)   LIT(bz), comma, comma, END
 I(again,  "again",  &w_until)   LIT(b), comma, comma, END
 I(fwhile, "while",  &w_again)   FTH(fif), END
 I(until,  "until",  &w_begin)   LIT(bz), comma, comma, END
 I(again,  "again",  &w_until)   LIT(b), comma, comma, END
 I(fwhile, "while",  &w_again)   FTH(fif), END


@@ -179,18 +193,20 @@ I(loop,   "loop",   &w_fdo)     LIT(popr), comma,
                                 LIT(popr2), comma,
                                 LIT(drop), comma, LIT(drop), comma, END
 W(immediate, "immediate", &w_loop) FTH(latest), LIT(2 * sizeof(intptr_t)), add,
                                 LIT(popr2), comma,
                                 LIT(drop), comma, LIT(drop), comma, END
 W(immediate, "immediate", &w_loop) FTH(latest), LIT(2 * sizeof(intptr_t)), add,

-                                   LIT(ATTR_IMMEDIATE), over, cpeek, or, swap, cpoke, END
+                                   dup, cpeek, LIT(ATTR_IMMEDIATE), or, swap, cpoke, END

 // Be sure to update LATEST_INIT in foci.h!
 
 static void enter_forth(void *ptr)
 {
 // Be sure to update LATEST_INIT in foci.h!
 
 static void enter_forth(void *ptr)
 {

+    static intptr_t *run[3] = {(intptr_t *)enter, 0, (intptr_t *)fend};
+    run[1] = (intptr_t *)ptr;
+

     STASH;
     sp = saved_sp;
     rp = saved_rp;
     STASH;
     sp = saved_sp;
     rp = saved_rp;

-    pp = ptr;
+    pp = run;

 
 

-    *--rp = (intptr_t **)fend_b;
-    ((void (*)())*pp)();
+    enter();

 
     saved_sp = sp;
     saved_rp = rp;
 
     saved_sp = sp;
     saved_rp = rp;


@@ -318,16 +334,11 @@ void init(intptr_t *dictmemm)
     saved_rp = END_OF(rstack);
 }
 
     saved_rp = END_OF(rstack);
 }
 

-int depth(void)
+int foci_depth(void)

 {
     return END_OF(dstack) - saved_sp;
 }
 
 {
     return END_OF(dstack) - saved_sp;
 }
 

-int rdepth(void)
-{
-    return END_OF(rstack) - saved_rp;
-}
-

 int compiling(void)
 {
     return STATE;
 int compiling(void)
 {
     return STATE;

diff --git a/foci.h b/foci.h
index b2b8e1c7b533fe4848ad72c62e13c80c80a7fbda..6c89395555e9a5e434a4e8a39446723fff0ac54e 100644 (file)
--- a/foci.h
+++ b/foci.h
@@ -94,8 +94,7 @@ extern void foci_putchar(int);
 extern int  foci_getchar(void);
 
 void init(intptr_t *dictmem);
 extern int  foci_getchar(void);
 
 void init(intptr_t *dictmem);

-int depth(void);
-int rdepth(void);
+int foci_depth(void);

 int compiling(void);
 void interpret(void);
 void define(const struct word_t *w);
 int compiling(void);
 void interpret(void);
 void define(const struct word_t *w);

diff --git a/x86/main.c b/x86/main.c
index fe4692a2624261a0d64ea163acacca91789f234c..4cd40922a71f221ac3d80f1e018b1e5a46c1553e 100644 (file)
--- a/x86/main.c
+++ b/x86/main.c
@@ -30,7 +30,7 @@ int main()
 
     for (;;) {
         interpret();
 
     for (;;) {
         interpret();

-        printf(compiling() ? "compiled <%d>\n" : "ok <%d>\n", depth());
+        printf(compiling() ? "compiled <%d>\n" : "ok <%d>\n", foci_depth());

     }
 
     return 0;
     }
 
     return 0;