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     HERE += 1
  69
  70     return -length(primitives)
  71 end
  72
  73 defVar(name::AbstractString, var::Symbol) = defPrim(name, quote
  74     pushPS($var)
  75     jmp = NEXT
  76 end)
  77
  78 defConst(name::AbstractString, val::Int64) = defPrim(name, quote
  79     pushPS($val)
  80     jmp = Next
  81 end)
  82
  83 # Threading Primitives
  84
  85 NEXT = defPrim("NEXT", quote
  86     W = memory[IP]
  87     IP += 1
  88     X = memory[W]
  89     jmp = X
  90 end)
  91
  92 DOCOL = defPrim("DOCOL", quote
  93     pushRS(IP)
  94     IP = W + 1
  95     jmp = NEXT
  96 end)
  97
  98 EXIT = defPrim("EXIT", quote
  99     IP = popRS()
 100     jmp = NEXT
 101 end)
 102
 103
 104 # Basic forth primitives
 105
 106 DROP = defPrim("DROP", quote
 107     popPS()
 108     jmp = NEXT
 109 end)
 110
 111 SWAP = defPrim("SWAP", quote
 112     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
 113     jmp = NEXT
 114 end)
 115
 116 DUP = defPrim("DUP", quote
 117     pushPS(PS[PSP])
 118     jmp = NEXT
 119 end)
 120
 121 LIT = defPrim("LIT", quote
 122     pushPS(memory[IP])
 123     IP += 1
 124     jmp = NEXT
 125 end)
 126
 127 # Memory primitives
 128
 129 STORE = defPrim("!", quote
 130     addr = popPS()
 131     dat = popPS()
 132     memory[addr] = dat
 133     jmp = NEXT
 134 end)
 135
 136 FETCH = defPrim("@", quote
 137     addr = popPS()
 138     pushPS(memory[addr])
 139     jmp = NEXT
 140 end)
 141
 142 ADDSTORE = defPrim("+!", quote
 143     addr = popPS()
 144     toAdd = popPS()
 145     memory[addr] += toAdd
 146     jmp = NEXT
 147 end)
 148
 149 SUBSTORE = defPrim("-!", quote
 150     addr = popPS()
 151     toSub = popPS()
 152     memory[addr] -= toSub
 153     jmp = NEXT
 154 end)
 155
 156
 157 # Built-in variables
 158
 159 defVar("STATE", :STATE)
 160 defVar("HERE", :HERE)
 161 defVar("LATEST", :LATEST)
 162 defVAR("BASE", :BASE)
 163
 164 # Constants
 165
 166 defConst("VERSION", 1)
 167 defConst("DOCOL", DOCOL)
 168
 169 # Return Stack
 170
 171 TOR = defPrim(">R", quote
 172     pushRS(popPS())
 173     jmp = NEXT
 174 end)
 175
 176 FROMR = defPrim("R>", quote
 177     pushPS(popRS())
 178 end)
 179
 180 RSPFETCH = defPrim("RSP@", quote
 181     pushPS(RSP)
 182     jmp = NEXT
 183 end)
 184
 185 RSPSTORE = defPrim("RSP!", quote
 186     RSP = popPS()
 187     jmp = NEXT
 188 end)
 189
 190 RDROP = defPrim("RDROP", quote
 191     popRS()
 192     jmp = NEXT
 193 end)
 194
 195 # Parameter Stack
 196
 197 PSPFETCH = defPrim("PSP@", quote
 198     pushPS(PSP)
 199     jmp = NEXT
 200 end)
 201
 202 PSPSTORE = defPrim("PSP!", quote
 203     PSP = popPS()
 204     jmp = NEXT
 205 end)
 206
 207 # I/O
 208
 209 KEY = defPrim("KEY", quote
 210     jmp = NEXT
 211 end)
 212
 213 # VM loop
 214 jmp = NEXT
 215 function runVM()
 216     while true
 217         eval(primitives[-jmp])
 218     end
 219 end
 220
 221 end