1 files changed, 95 insertions, 0 deletions
diff --git a/core.fth b/core.fth
new file mode 100644
index 0000000..d267d08
--- /dev/null
+++ b/core.fth
@@ -0,0 +1,95 @@
+: cell+    [ 1 cells ] literal + ;
+: char+    1 + ;
+: chars    ;
+
+: 1+       1 + ;
+: 1-       1 - ;
+
+: over     1 pick ;
+: rot      >r swap r> swap ;
+: -rot     rot rot ;
+
+: +!       dup >r swap r> @ + swap ! ;
+
+: imm      immediate ;
+
+: base     [ 0 _d ] literal ;
+: here     [ 1 cells _d ] literal @ ;
+: allot    [ 1 cells _d ] literal +! ;
+: state    [ 3 cells _d ] literal ;
+: _compxt  [ 4 cells _d ] literal ;
+: _source  [ 5 cells _d ] literal ;
+: _sourceu [ 6 cells _d ] literal ;
+: >in      [ 7 cells _d ] literal ;
+: _begin   [ 8 cells 80 chars + _d ] literal ;
+
+: c,       here c! 1 allot ;
+
+: if       ['] _jmp0 compile, here 0 , ; imm
+: then     here swap ! ; imm
+: else     ['] _jmp compile, here 0 , swap here swap ! ; imm
+
+: postpone ' dup _i swap [ ' literal compile, ]
+           if ['] execute else ['] , then compile, ; imm
+
+: 2drop    drop drop ;
+: 2dup     over over ;
+: 2over    3 pick 3 pick ;
+: 2swap    rot >r rot r> ;
+
+: decimal  10 base ! ;
+
+: 2r>      ['] r> compile, ['] r> compile, ['] swap compile, ; imm
+: 2>r      ['] swap compile, ['] >r compile, ['] >r compile, ; imm
+: r@       ['] r> compile, ['] dup compile, ['] >r compile, ; imm
+
+: 2!       swap over ! cell+ ! ;
+: 2@       dup cell+ @ swap @ ;
+
+: 0=       0 = ;
+: 0<       0 < ;
+: <=       2dup < >r = r> or ;
+: >        swap < ;
+: <>       = 0= ;
+
+: begin    0 here ; imm
+: while    swap 1+ swap postpone if -rot ; imm
+: repeat   ['] _jmp compile, , if postpone then then ; imm
+: until    ['] _jmp0 compile, , drop ; imm
+
+: do       0 postpone literal here 1 cells -
+           ['] >r compile, postpone 2>r here ; imm
+: unloop   postpone 2r> ['] 2drop compile,
+           ['] r> compile, ['] drop compile, ; imm
+: leave    postpone 2r> ['] 2drop compile, ['] exit compile, ; imm
+: +loop    ['] r> compile,   ['] 2dup compile, ['] + compile,
+           postpone r@       ['] swap compile, ['] >r compile,
+           ['] - compile,    ['] 2dup compile, ['] + compile,
+           ['] over compile, ['] xor compile,  ['] rot compile,
+           ['] rot compile,  ['] xor compile,  ['] and compile,
+           0 postpone literal ['] < compile, ['] _jmp0 compile, ,
+           postpone unloop here 1 cells - swap ! ; imm
+: loop     postpone 2r> ['] 1+ compile, ['] 2dup compile,
+           postpone 2>r ['] = compile, ['] _jmp0 compile, ,
+           postpone unloop here 1 cells - swap ! ; imm
+: i        postpone r@ ; imm
+: j        postpone 2r> ['] r> compile, postpone r@ ['] swap compile,
+           ['] >r compile, ['] -rot compile, postpone 2>r ; imm
+
+: invert   -1 ^ ;
+: 2*       2 * ;
+: _msb     [ 1 1 cells 8 * 1- lshift ] literal ;
+: 2/       dup 1 rshift swap 0< if _msb or then ;
+
+: cr       10 emit ;
+: bl       32 ;
+: space    bl emit ;
+: spaces   begin dup 0 > while space 1- repeat drop ;
+
+: ?dup     dup if dup then ;
+
+: negate   -1 * ;
+: abs      dup 0< if negate then ;
+: min      2dup <= if drop else swap drop then ;
+: max      2dup <= if swap drop else drop then ;
+