-
Notifications
You must be signed in to change notification settings - Fork 2
/
my_tests.FORTH
154 lines (111 loc) · 3.69 KB
/
my_tests.FORTH
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
: -1 s@ s@ nand s@ nand ;
: 0 -1 -1 nand ;
: 1 -1 -1 + -1 nand ;
: 2 1 1 + ;
: 4 2 2 + ;
: 6 2 4 + ;
: >in s@ 2 + ;
: latest s@ 4 + ;
: here s@ 6 + ;
: 8 6 2 + ;
: 10 6 4 + ;
: sp s@ 8 + ;
: rp s@ 10 + ;
: cr 10 emit ;
: dup sp @ @ ;
: invert dup nand ;
: - invert 1 + + ;
: <> - 0# ;
: = <> invert ;
: drop dup - + ;
: over sp @ 2 + @ ;
: swap over over sp @ 6 + ! sp @ 2 + ! ;
: 2dup over over ;
: 2drop drop drop ;
: and nand invert ;
: or invert swap invert and invert ;
: alloc here @ + here ! ;
: , here @ ! 2 alloc ;
: 2* dup + ;
: 80h 1 2* 2* 2* 2* 2* 2* 2* ;
: immediate latest @ 2 + dup @ 80h or swap ! ;
: [ 0 s@ ! ; immediate
: ] 1 s@ ! ;
: >r rp @ @ swap rp @ ! rp @ 2 - rp ! rp @ ! ;
: r> rp @ @ rp @ 2 + rp ! rp @ @ swap rp @ ! ;
: branch rp @ @ dup @ + rp @ ! ;
: ?branch 0# invert rp @ @ @ 2 - and rp @ @ + 2 + rp @ ! ;
: lit rp @ @ dup 2 + rp @ ! @ ;
: ['] rp @ @ dup 2 + rp @ ! @ ;
: rot >r swap r> swap ;
: if ['] ?branch , here @ 0 , ; immediate
: then dup here @ swap - swap ! ; immediate
: else ['] branch , here @ 0 , swap dup
here @ swap - swap ! ; immediate
: begin here @ ; immediate
: again ['] branch , here @ - , ; immediate
: until ['] ?branch , here @ - , ; immediate
: while ['] ?branch , here @ 0 , ; immediate
: repeat swap ['] branch , here @ - ,
dup here @ swap - swap ! ; immediate
: do here @ ['] >r , ['] >r , ; immediate
: loop ['] r> , ['] r> , ['] lit , 1 , ['] + ,
['] 2dup , ['] = , ['] ?branch ,
here @ - , ['] 2drop , ; immediate
: 0fh lit [ 4 4 4 4 + + + 1 - , ] ;
: ffh lit [ 0fh 2* 2* 2* 2* 0fh or , ] ;
: c@ @ ffh and ;
: in> >in @ c@ >in dup @ 1 + swap ! ;
: bl lit [ 1 2* 2* 2* 2* 2* , ] ;
: type 0 do dup c@ emit 1 + loop drop ;
: parse in> drop >in @ swap 0 begin over in>
<> while 1 + repeat swap bl
= if >in dup @ 1 - swap ! then ;
: word in> drop begin dup in> <> until >in @ 2 - >in ! parse ;
: [char] ['] lit , bl word drop c@ , ; immediate
: ." [char] " parse type ; immediate
: ( [char] ) parse drop drop ; immediate
( with comments )
." Hello world !" cr
: create here @ : ['] lit , here @ 4 + , ['] exit , 0 s@ ! latest ! ;
: cells lit [ 2 , ] ;
: allot here @ + here ! ;
: variable create cells allot ;
: 48 lit [ 6 6 + 6 + 6 + 6 + 6 + 6 + 6 + , ] ;
variable tape_head
variable loop_depth
variable parse_index
: runbf 0 parse_index !
begin parse_index @ c@
dup dup dup dup dup dup dup
[char] , = if key tape_head @ ! then
[char] - = if tape_head @ @ 1 - tape_head @ ! then
[char] + = if tape_head @ @ 1 + tape_head @ ! then
[char] < = if tape_head @ 2 - tape_head ! then
[char] > = if tape_head @ 2 + tape_head ! then
[char] . = if tape_head @ @ emit then
[char] [ = tape_head @ @ 0 = and if 1 loop_depth !
begin parse_index @ 1 + parse_index ! parse_index @ c@ dup
[char] [ = if loop_depth @ 1 + loop_depth ! then
[char] ] = if loop_depth @ 1 - loop_depth ! then
loop_depth @ 0 = until then
[char] ] = tape_head @ @ 0 <> and if 1 loop_depth !
begin parse_index @ 1 - parse_index ! parse_index @ c@ dup
[char] [ = if loop_depth @ 1 - loop_depth ! then
[char] ] = if loop_depth @ 1 + loop_depth ! then
loop_depth @ 0 = until then
parse_index @ 1 + parse_index !
dup parse_index @ = until drop ;
: BF( [char] ) parse runbf ; immediate
here @ 48 + tape_head !
tape_head
dup @
.S cr
.R cr
BF( >++++++++[<+++++++++>-]
<.>++++[<+++++++>-]
<+.+++++++..+++.>>++++++[<+++++++>-]
<++.------------.>++++++[<+++++++++>-]
<+.<.+++.------.--------.>>>++++[<++++++++>-]
<+. )
words