On to constants.
[forth.jl.git] / src / forth.jl
1 module forth
2
3 RS = Array{Int64, 1}(1024)
4 RSP = 0
5
6 PS = Array{Int64, 1}(1024)
7 PSP =0
8
9 IP = 0
10 W = 0
11 X = 0
12
13 jmp = 0
14
15 primitives = Array{Expr,1}()
16 memory = Array{Int64,1}(64*1024)
17 LATEST = 0
18 HERE = 1
19
20 # Intperpreter state
21
22 STATE = 0
23
24 # Current radix
25
26 BASE = 10
27
28 # Stack manipulation macros
29
30 function pushRS(val::Int64)
31     global RSP
32     RS[RSP += 1] = val
33 end
34
35 function popRS()
36     global RSP
37     val = RS[RSP]
38     RSP -= 1
39     return val
40 end
41
42 function pushPS(val::Int64)
43     global PSP
44     PS[PSP += 1] = val
45 end
46
47 function popPS()
48     global PSP
49     val = PS[PSP]
50     PSP -= 1
51     return val
52 end
53
54 # Primitive creation functions
55
56 function defPrim(name::AbstractString, expr::Expr)
57     global HERE, LATEST
58
59     memory[HERE] = LATEST
60     LATEST = HERE
61     HERE += 1
62
63     memory[HERE] = length(name); HERE += 1
64     memory[HERE:(HERE+length(name)-1)] = [Int(c) for c in name]; HERE += length(name)
65
66     push!(primitives, expr)
67     memory[HERE] = -length(primitives)
68     codeword = HERE
69     HERE += 1
70
71     return codeword
72 end
73
74 function defVar(name::AbstractString, var::Expr)
75     defPrim(name, Expr(:call, :pushPS, var))
76 end
77
78 # Threading Primitives
79
80 NEXT = defPrim("NEXT", :(begin
81     W = memory[IP]
82     IP += 1
83     X = memory[W]
84     jmp = X
85 end))
86
87 DOCOL = defPrim("DOCOL", :(begin
88     pushRS(IP)
89     IP = W + 1
90     jmp = NEXT
91 end))
92
93 EXIT = defPrim("EXIT", :(begin
94     IP = popRS()
95     jmp = NEXT
96 end))
97
98
99 # Basic forth primitives
100
101 DROP = defPrim("DROP", :(begin
102     popPS()
103 end))
104
105 SWAP = defPrim("SWAP", :(begin
106     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
107 end))
108
109 DUP = defPrim("DUP", :(begin
110     pushPS(PS[PSP])
111 end))
112
113 LIT = defPrim("LIT", :(begin
114     pushPS(memory[IP])
115     IP += 1
116 end))
117
118 # Memory primitives
119
120 STORE = defPrim("!", :(begin
121     addr = popPS()
122     dat = popPS()
123     memory[addr] = dat
124 end))
125
126 FETCH = defPrim("@", :(begin
127     addr = popPS()
128     pushPS(memory[addr])
129 end))
130
131 ADDSTORE = defPrim("+!", :(begin
132     addr = popPS()
133     toAdd = popPS()
134     memory[addr] += toAdd
135 end))
136
137 SUBSTORE = defPrim("-!", :(begin
138     addr = popPS()
139     toSub = popPS()
140     memory[addr] -= toSub
141 end))
142
143
144 # Built-in variables
145
146 defVar("STATE", :STATE)
147 defVar("HERE", :HERE)
148 defVar("LATEST", :LATEST)
149 defVAR("PSP", :PSP)
150 defVAR("BASE", :BASE)
151
152 # Constants
153
154
155
156 # VM loop
157 jmp = NEXT
158 function runVM()
159     while true
160         eval(primitives[-memory[jmp]])
161     end
162 end
163
164 end