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