1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
-1 constant true
0 constant false
: unused 1 sys ;
: hex 16 base ! ;
: nip swap drop ;
: tuck swap over ;
: 0> 0 > ;
: 0<> 0= 0= ;
: u> swap u< ;
: within over - >r - r> swap u> ;
: 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
: compile, postpone literal postpone execute ;
: [compile] bl word find -1 = if , else compile, then ; imm
: \ _source @ >in @ +
begin dup c@ while 0 over c! char+ repeat drop ; imm
: again postpone repeat ; imm
: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave ,
postpone then postpone 2>r here ; imm
: .( [char] ) word count type ; imm
: c" state @ if ['] _jmp , here 0 , then
[char] " word
state @ 0= if exit then
dup count nip allot
here rot !
postpone literal ; imm
: buffer: create allot ;
: value constant ;
: to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
: defer create does> @ execute ;
: defer@ >body @ ;
: defer! >body ! ;
: is state @ if postpone ['] postpone defer! else ' defer! then ; imm
: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
: erase 0 fill ;
: roll dup if swap >r 1- recurse r> swap exit then drop ;
: marker here _latest @ create , , does>
dup @ _latest ! cell+ @ here - allot ;
: case ['] _lit , 1 here 0 , ['] drop , ; imm
: of ['] over , ['] = , postpone if ; imm
: endof ['] _jmp , here >r 0 , postpone then
swap 1+ swap r> tuck ! ; imm
: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm
: holds begin dup while 1- 2dup + c@ hold repeat 2drop ;
: .r over dup 0< if 1 else 0 then
begin 1+ swap base @ / dup 0<> while swap repeat
drop - spaces . ;
: u.r over 0 begin 1+ swap 0 base @ _/ dup 0<> while swap repeat
drop - spaces u. ;
( WORD uses HERE and must be at least 33 characters. )
: pad here 50 chars + align ;
|
