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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
: chars ;
: state [ _d 7 cells + ] literal ;
\ : [ 0 state ! ; immediate
\ : ] -1 state ! ;
: sp [ _d cell+ ] literal ;
: rp [ _d 2 cells + ] literal ;
: dp [ _d 4 cells + ] literal ;
: sp@ sp @ ;
: rp@ rp @ cell+ ;
: ip [ _d 3 cells + ] literal ;
: here dp @ ;
: unused [ _d 8 cells + ] literal @ here - ;
: base [ _d 9 cells + ] literal ;
: latest _d @ ;
\ : dup sp@ @ ;
\ : drop sp@ cell+ sp ! ;
: pick cells cell+ sp@ + @ ;
: >r rp@ cell - rp !
rp@ cell+ @ rp@ !
rp@ cell+ ! ;
: r> rp@ @
rp@ cell+ rp !
rp@ @ swap rp@ ! ;
\ : rot >r swap r> swap ;
: -rot rot rot ;
: over 1 pick ;
: 2drop drop drop ;
: 2dup over over ;
: 2over 3 pick 3 pick ;
: 2swap rot >r rot r> ;
: +! dup >r swap r> @ + swap ! ;
: allot dp +! ;
: , here ! cell allot ;
: c, here c! 1 allot ;
: ['] ' [ ' literal , ] ; immediate
: if ['] _jmp0 , here 0 , ; immediate
: then here swap ! ; immediate
: else ['] _jmp , here 0 , swap here swap ! ; immediate
: 2r> ['] r> , ['] r> , ['] swap , ; immediate
: 2>r ['] swap , ['] >r , ['] >r , ; immediate
: r@ ['] r> , ['] dup , ['] >r , ; immediate
: 2! swap over ! cell+ ! ;
: 2@ dup cell+ @ swap @ ;
: 0= 0 = ;
: 0< 0 < ;
: <= 2dup < >r = r> or ;
: > swap < ;
: <> = 0= ;
: 1+ 1 + ;
: 1- 1 - ;
: invert -1 xor ;
: negate -1 * ;
: 2* 2 * ;
: _msb [ 1 cell 8 * 1- lshift ] literal ;
: 2/ dup 1 rshift swap 0< if _msb or then ;
: ?dup dup if dup then ;
: abs dup 0< if negate then ;
: min 2dup <= if drop else swap drop then ;
: max 2dup <= if swap drop else drop then ;
: aligned cell 1- + cell 1- invert and ;
: align here dup aligned swap - allot ;
: cr 10 emit ;
: bl 32 ;
: space bl emit ;
\ : spaces begin dup 0 > while space 1- repeat drop ;
: decimal 10 base ! ;
: hex 16 base ! ;
: begin 0 here ; immediate
: while swap 1+ swap postpone if -rot ; immediate
: repeat ['] _jmp , , if postpone then then ; immediate
: until ['] _jmp0 , , drop ; immediate
: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
: unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
: leave postpone 2r> ['] 2drop , ['] exit , ; immediate
: +loop ['] r> , ['] 2dup , ['] + ,
postpone r@ ['] swap , ['] >r ,
['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 ,
['] < , ['] _jmp0 , ,
postpone unloop here 1 cells - swap ! ; immediate
: loop postpone 2r> ['] 1+ , ['] 2dup ,
postpone 2>r ['] = , ['] _jmp0 , ,
postpone unloop here 1 cells - swap ! ; immediate
: i postpone r@ ; immediate
: j postpone 2r> ['] r> , postpone r@ ['] swap ,
['] >r , ['] -rot , postpone 2>r ; immediate
: create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ;
: >body [ 2 cells ] literal + @ ;
: _does> latest dup cell+ @ [ 5 cells ] literal + +
['] _jmp over ! cell+ ! ;
: does> here 4 cells + postpone literal ['] _does> , 0 , ; immediate
: variable create cell allot ;
: constant create , does> @ ;
|
