diff options
| -rw-r--r-- | compat.txt | 18 | ||||
| -rw-r--r-- | core.fth | 51 |
2 files changed, 41 insertions, 28 deletions
@@ -15,7 +15,7 @@ yes 6.1.0140 +LOOP yes 6.1.0150 , yes 6.1.0160 - yes 6.1.0180 . - 6.1.0190 ." +yes 6.1.0190 ." yes 6.1.0230 / 6.1.0240 /MOD yes 6.1.0250 0< @@ -58,11 +58,11 @@ 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.0895 CHAR yes 6.1.0897 CHAR+ yes 6.1.0898 CHARS 6.1.0950 CONSTANT - 6.1.0980 COUNT +yes 6.1.0980 COUNT yes 6.1.0990 CR 6.1.1000 CREATE yes 6.1.1170 DECIMAL @@ -114,11 +114,11 @@ yes 6.1.2162 RSHIFT 6.1.2214 SM/REM 6.1.2216 SOURCE yes 6.1.2220 SPACE - 6.1.2230 SPACES +yes 6.1.2230 SPACES yes 6.1.2250 STATE yes 6.1.2260 SWAP yes 6.1.2270 THEN - 6.1.2310 TYPE +yes 6.1.2310 TYPE 6.1.2320 U. 6.1.2340 U< 6.1.2360 UM* @@ -127,10 +127,10 @@ yes 6.1.2270 THEN yes 6.1.2390 UNTIL 6.1.2410 VARIABLE yes 6.1.2430 WHILE - 6.1.2450 WORD +yes 6.1.2450 WORD yes 6.1.2490 XOR - 6.1.2500 [ +yes 6.1.2500 [ yes 6.1.2510 ['] - 6.1.2520 [CHAR] - 6.1.2540 ] +yes 6.1.2520 [CHAR] +yes 6.1.2540 ] @@ -29,8 +29,18 @@ : char+ 1+ ; : chars ; -: 2r> r> r> swap ; -: 2>r swap >r >r ; +: base 0 ; +: state 2 ; +: decimal 1 1+ base ! 1010 base ! ; + +: postpone 1 4 ! ; imm +: ['] ' postpone literal ; imm +: [ 0 state ! ; imm +: ] 1 state ! ; + +: 2r> ['] r> , ['] r> , ['] swap , ; imm +: 2>r ['] swap , ['] >r , ['] >r , ; imm +: r@ ['] r> , ['] dup , ['] >r , ; imm : 2! swap over ! cell+ ! ; : 2@ dup cell+ @ swap @ ; @@ -40,29 +50,21 @@ : 0< 0 < ; : <= - 1- 0< ; : > <= 0= ; - -: base 0 ; -: state 2 ; -: decimal 1 1+ base ! 1010 base ! ; - -: postpone 1 4 ! ; imm -: ['] ' postpone literal ; imm - -: r@ ['] r> , ['] dup , ['] >r , ; imm +: <> = 0= ; : if ['] _jmp0 , here 0 , ; imm : then here swap ! ; imm : else ['] _jmp , here 0 , here rot ! ; imm -: begin here 0 ; imm -: while 1+ postpone if swap ; imm -: repeat ['] _jmp , if swap , postpone then else , then ; imm -: until drop ['] _jmp0 , , ; imm +: begin 0 here ; imm +: while swap 1+ swap postpone if -rot ; imm +: repeat ['] _jmp , , if postpone then then ; imm +: until ['] _jmp0 , , drop ; imm -: do ['] swap , ['] >r , ['] >r , here ; imm -: +loop ['] r> , ['] r> , ['] swap , ['] rot , ['] + , ['] 2dup , - ['] swap , ['] >r , ['] >r , ['] - , ['] 0= , - ['] _jmp0 , , ['] r> , ['] r> , ['] swap , ['] 2drop , ; imm +: do postpone 2>r here ; imm +: +loop postpone 2r> ['] rot , ['] + , ['] 2dup , + postpone 2>r ['] - , ['] 0= , ['] _jmp0 , , + postpone 2r> ['] 2drop , ; imm : loop 1 postpone literal postpone +loop ; imm : i postpone r@ ; imm @@ -81,6 +83,7 @@ : cr 9 emit ; : bl 32 ; : space bl emit ; +: spaces begin dup 0 > while space 1- repeat ; : ?dup dup if dup then ; @@ -88,3 +91,13 @@ : abs dup 0< if negate then ; : min 2dup <= if drop else nip then ; : max 2dup <= if nip else drop then ; + +: word here -1 cells over ! dup cell+ rot begin key 2dup <> while + 2 pick c! swap char+ swap repeat + 2drop over - over +! ; +: count dup cell+ swap @ ; +: char bl word cell+ c@ ; +: [char] char postpone literal ; imm + +: type begin dup 0 > while swap dup c@ emit char+ swap 1- repeat ; +: ." [char] " word count type ; |