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