bf-forth/bf.fs at master · w-k/bf-forth · GitHub

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
#! /usr/local/bin/gforth

43 Constant plus        \   +
45 Constant minus       \   -
60 Constant lt          \   <
62 Constant gt          \   >
44 Constant comma       \   ,
46 Constant period      \   .
91 Constant open_paren  \   [
93 Constant close_paren \   ]

create cellArray 30000 chars allot
cellArray 30000 chars erase
create stdinBuffer 1 chars allot
create srcArray 1000 chars allot

next-arg r/o open-file throw Value src
srcArray 1000 src read-file throw Value length

: readStdinChar ( stdinBuffer -- char )
  dup 1 stdin read-file throw drop
  c@
;

: getC ( index arrayAddr -- index arrayAddr val )
  over over swap
  chars + c@
;

: updateC ( index arrayAddr val -- index )
  rot rot over
  chars +
  rot swap
  c!
;

: findNext ( srcIndex query -- newSrcIndex )
  swap 1+
  begin
    srcArray getC
    swap drop
    rot
    over over <> while
      rot 1+
      rot drop
  repeat
  drop drop
;

: findPrevious ( srcIndex query -- newSrcIndex )
  swap 1-
  begin
    srcArray getC
    swap drop
    rot
    over over <> while
      rot 1-
      rot drop
  repeat
  drop drop
;

: handleChar ( cellIndex srcIndex character -- cellIndex srcIndex )

  dup plus = if
    rot
    cellArray getC 1+ updateC
    rot rot
  then

  dup minus = if
    rot
    cellArray getC 1- updateC
    rot rot
  then

  dup lt = if
    rot
    1-
    rot rot
  then

  dup gt = if
    rot
    1+
    rot rot
  then

  dup comma = if
    rot
    cellArray stdinBuffer readStdinChar
    updateC
    rot rot
  then

  dup period = if
    rot
    cellArray getC emit
    drop
    rot rot
  then

  dup open_paren = if
    rot
    cellArray getC swap drop
    0 = if
      rot
      close_paren findNext
      rot rot
    then
    rot rot
  then

  dup close_paren = if
    rot
    cellArray getC swap drop
    0 <> if
      rot
      open_paren findPrevious
      rot rot
    then
    rot rot
  then

  drop
  1+
;

: read ( -- )
  0 0 begin
    dup length < while
      srcArray over chars + c@
      handleChar
  repeat
;

read

bye