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 # Input buffer
  29
  30 tib_size = 4096
  31 tib = length(memory) - tib_size
  32 numtib = 0
  33 toin = 0
  34
  35 # Stack manipulation functions
  36
  37 function pushRS(val::Int64)
  38     global RSP
  39     RS[RSP += 1] = val
  40 end
  41
  42 function popRS()
  43     global RSP
  44     val = RS[RSP]
  45     RSP -= 1
  46     return val
  47 end
  48
  49 function pushPS(val::Int64)
  50     global PSP
  51     PS[PSP += 1] = val
  52 end
  53
  54 function popPS()
  55     global PSP
  56     val = PS[PSP]
  57     PSP -= 1
  58     return val
  59 end
  60
  61 # Primitive creation and calling functions
  62
  63 function defPrim(name::AbstractString, expr::Expr)
  64     global HERE, LATEST
  65
  66     memory[HERE] = LATEST
  67     LATEST = HERE
  68     HERE += 1
  69
  70     memory[HERE] = length(name); HERE += 1
  71     memory[HERE:(HERE+length(name)-1)] = [Int(c) for c in name]; HERE += length(name)
  72
  73     push!(primitives, expr)
  74     memory[HERE] = -length(primitives)
  75     HERE += 1
  76
  77     return -length(primitives)
  78 end
  79
  80 defVar(name::AbstractString, var::Symbol) = defPrim(name, quote
  81     pushPS($var)
  82     jmp = NEXT
  83 end)
  84
  85 defConst(name::AbstractString, val::Int64) = defPrim(name, quote
  86     pushPS($val)
  87     jmp = Next
  88 end)
  89
  90 callPrim(addr::Int64) = eval(primitives[-addr])
  91
  92 # Threading Primitives
  93
  94 NEXT = defPrim("NEXT", quote
  95     W = memory[IP]
  96     IP += 1
  97     X = memory[W]
  98     jmp = X
  99 end)
 100
 101 DOCOL = defPrim("DOCOL", quote
 102     pushRS(IP)
 103     IP = W + 1
 104     jmp = NEXT
 105 end)
 106
 107 EXIT = defPrim("EXIT", quote
 108     IP = popRS()
 109     jmp = NEXT
 110 end)
 111
 112
 113 # Basic forth primitives
 114
 115 DROP = defPrim("DROP", quote
 116     popPS()
 117     jmp = NEXT
 118 end)
 119
 120 SWAP = defPrim("SWAP", quote
 121     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
 122     jmp = NEXT
 123 end)
 124
 125 DUP = defPrim("DUP", quote
 126     pushPS(PS[PSP])
 127     jmp = NEXT
 128 end)
 129
 130 LIT = defPrim("LIT", quote
 131     pushPS(memory[IP])
 132     IP += 1
 133     jmp = NEXT
 134 end)
 135
 136 # Memory primitives
 137
 138 STORE = defPrim("!", quote
 139     addr = popPS()
 140     dat = popPS()
 141     memory[addr] = dat
 142     jmp = NEXT
 143 end)
 144
 145 FETCH = defPrim("@", quote
 146     addr = popPS()
 147     pushPS(memory[addr])
 148     jmp = NEXT
 149 end)
 150
 151 ADDSTORE = defPrim("+!", quote
 152     addr = popPS()
 153     toAdd = popPS()
 154     memory[addr] += toAdd
 155     jmp = NEXT
 156 end)
 157
 158 SUBSTORE = defPrim("-!", quote
 159     addr = popPS()
 160     toSub = popPS()
 161     memory[addr] -= toSub
 162     jmp = NEXT
 163 end)
 164
 165
 166 # Built-in variables
 167
 168 defVar("STATE", :state)
 169 defVar("HERE", :here)
 170 defVar("LATEST", :latest)
 171 defVar("BASE", :base)
 172
 173 # Constants
 174
 175 defConst("VERSION", 1)
 176 defConst("DOCOL", DOCOL)
 177
 178 # Return Stack
 179
 180 TOR = defPrim(">R", quote
 181     pushRS(popPS())
 182     jmp = NEXT
 183 end)
 184
 185 FROMR = defPrim("R>", quote
 186     pushPS(popRS())
 187 end)
 188
 189 RSPFETCH = defPrim("RSP@", quote
 190     pushPS(RSP)
 191     jmp = NEXT
 192 end)
 193
 194 RSPSTORE = defPrim("RSP!", quote
 195     RSP = popPS()
 196     jmp = NEXT
 197 end)
 198
 199 RDROP = defPrim("RDROP", quote
 200     popRS()
 201     jmp = NEXT
 202 end)
 203
 204 # Parameter Stack
 205
 206 PSPFETCH = defPrim("PSP@", quote
 207     pushPS(PSP)
 208     jmp = NEXT
 209 end)
 210
 211 PSPSTORE = defPrim("PSP!", quote
 212     PSP = popPS()
 213     jmp = NEXT
 214 end)
 215
 216 # I/O
 217
 218 defConst("TIB", tib)
 219 defVar("#TIB", :numtib)
 220 defVar(">IN", :toin)
 221
 222 KEY = defPrim("KEY", quote
 223     if toin >= numtib
 224
 225     end
 226
 227     jmp = NEXT
 228 end)
 229
 230 EMIT = defPrim("EMIT", quote
 231
 232     jmp = NEXT
 233 end)
 234
 235 WORD = defPrim("WORD", quote
 236
 237     jmp = NEXT
 238 end)
 239
 240 NUMBER = defPrim("NUMBER", quote
 241
 242     jmp = NEXT
 243 end)
 244
 245 #### VM loop ####
 246 jmp = NEXT
 247 function runVM()
 248     while true
 249         callPrim(jmp)
 250     end
 251 end
 252
 253 end