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 defVar(name::AbstractString, var::Expr) = defPrim(name, Expr(:call, :pushPS, var))
  75 defConst(name::AbstractString, val::Int64) = defPrim(name, Expr(:call, :pushPS, :val))
  76
  77 # Threading Primitives
  78
  79 NEXT = defPrim("NEXT", :(begin
  80     W = memory[IP]
  81     IP += 1
  82     X = memory[W]
  83     jmp = X
  84 end))
  85
  86 DOCOL = defPrim("DOCOL", :(begin
  87     pushRS(IP)
  88     IP = W + 1
  89     jmp = NEXT
  90 end))
  91
  92 EXIT = defPrim("EXIT", :(begin
  93     IP = popRS()
  94     jmp = NEXT
  95 end))
  96
  97
  98 # Basic forth primitives
  99
 100 DROP = defPrim("DROP", :(begin
 101     popPS()
 102     jmp = NEXT
 103 end))
 104
 105 SWAP = defPrim("SWAP", :(begin
 106     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
 107     jmp = NEXT
 108 end))
 109
 110 DUP = defPrim("DUP", :(begin
 111     pushPS(PS[PSP])
 112     jmp = NEXT
 113 end))
 114
 115 LIT = defPrim("LIT", :(begin
 116     pushPS(memory[IP])
 117     IP += 1
 118     jmp = NEXT
 119 end))
 120
 121 # Memory primitives
 122
 123 STORE = defPrim("!", :(begin
 124     addr = popPS()
 125     dat = popPS()
 126     memory[addr] = dat
 127     jmp = NEXT
 128 end))
 129
 130 FETCH = defPrim("@", :(begin
 131     addr = popPS()
 132     pushPS(memory[addr])
 133     jmp = NEXT
 134 end))
 135
 136 ADDSTORE = defPrim("+!", :(begin
 137     addr = popPS()
 138     toAdd = popPS()
 139     memory[addr] += toAdd
 140     jmp = NEXT
 141 end))
 142
 143 SUBSTORE = defPrim("-!", :(begin
 144     addr = popPS()
 145     toSub = popPS()
 146     memory[addr] -= toSub
 147     jmp = NEXT
 148 end))
 149
 150
 151 # Built-in variables
 152
 153 defVar("STATE", :STATE)
 154 defVar("HERE", :HERE)
 155 defVar("LATEST", :LATEST)
 156 defVAR("BASE", :BASE)
 157
 158 # Constants
 159
 160 defConst("VERSION", 1)
 161 defConst("DOCOL", DOCOL)
 162
 163 # Return Stack
 164
 165 TOR = defPrim(">R", :(pushRS(popPS())))
 166 FROMR = defPrim("R>", :(pushPS(popRS())))
 167 RSPFETCH = defPrim("RSP@", :(pushPS(RSP)))
 168 RSPSTORE = defPrim("RSP!", :(RSP = popPS()))
 169 RDROP = defPrim("RDROP", :(popRS()))
 170
 171 # Parameter Stack
 172
 173 PSPFETCH = defPrim("PSP@", :(pushPS(PSP)))
 174 PSPSTORE = defPrim("PSP!", :(PSP = popPS()))
 175
 176 # VM loop
 177 jmp = NEXT
 178 function runVM()
 179     while true
 180         eval(primitives[-memory[jmp]])
 181     end
 182 end
 183
 184 end