src/forth.jl

   1 module forth
   2
   3 # VM memory size
   4 size_memory = 640*1024
   5
   6 # Buffer sizes
   7 size_RS = 1024  # Return stack size
   8 size_PS = 1024  # Parameter stack size
   9 size_TIB = 4096 # Terminal input buffer size
  10
  11 # VM registers
  12 RSP = 0 # Return stack pointer
  13 PSP =0  # Parameter/data stack pointer
  14 IP = 0  # Instruction pointer
  15 W = 0   # Working register
  16 X = 0   # Extra register
  17
  18 RSP0 = 1
  19 PSP0 = RSP0 + size_RS
  20 here = PSP0 + size_PS + size_TIB  # location of bottom of dictionary
  21 latest = 0 # no previous definition
  22
  23 # The following array constitutes the memory of the VM. It has the following geography:
  24 #
  25 # memory = +-----------------------+
  26 #          | Return Stack          |
  27 #          +-----------------------+
  28 #          | Parameter Stack       |
  29 #          +-----------------------+
  30 #          | Terminal Input Buffer |
  31 #          +-----------------------+
  32 #          | Dictionary            |
  33 #          +-----------------------+
  34 #
  35 # Note that all words (user-defined, primitive, variables, etc) are included in
  36 # the dictionary.
  37 #
  38 # Simple linear addressing is used with one exception: references to primitive code
  39 # blocks, which are represented as anonymous functions, appear the negative index
  40 # into the primitives array which contains only these functions.
  41
  42 memory = Array{Int64,1}(size_memory)
  43 primitives = Array{Function,1}()
  44
  45
  46 # Stack manipulation functions
  47
  48 function pushRS(val::Int64)
  49     global RSP
  50     memory[RSP+=1] = val
  51 end
  52
  53 function popRS()
  54     global RSP
  55     val = memory[RSP]
  56     RSP -= 1
  57     return val
  58 end
  59
  60 function pushPS(val::Int64)
  61     global PSP
  62     memory[PSP += 1] = val
  63 end
  64
  65 function popPS()
  66     global PSP
  67     val = PS[PSP]
  68     PSP -= 1
  69     return val
  70 end
  71
  72 # Primitive creation and calling functions
  73
  74 function defPrim(name::AbstractString, f::Function)
  75     global latest, here
  76
  77     memory[here] = latest
  78     latest = here
  79     here += 1
  80
  81     memory[here] = length(name); here += 1
  82     memory[here:(here+length(name)-1)] = [Int(c) for c in name]; here += length(name)
  83
  84     push!(primitives, f)
  85     memory[here] = -length(primitives)
  86     here += 1
  87
  88     return -length(primitives)
  89 end
  90
  91 callPrim(addr::Int64) = primitives[-addr]()
  92
  93 function defVar(name::AbstractString, val::Int64)
  94     global latest, here
  95
  96     memory[here] = latest
  97     latest = here
  98     here += 1
  99
 100     memory[here] = length(name); here += 1
 101     memory[here:(here+length(name)-1)] = [Int(c) for c in name]; here += length(name)
 102
 103     push!(primitives, () -> begin
 104
 105     end)
 106
 107     pushPS($var)
 108     jmp = NEXT
 109 end
 110
 111 # Threading Primitives
 112
 113 NEXT = defPrim("NEXT", () -> begin
 114     W = memory[IP]
 115     IP += 1
 116     X = memory[W]
 117     return X
 118 end)
 119
 120 DOCOL = defPrim("DOCOL", () -> begin
 121     pushRS(IP)
 122     IP = W + 1
 123     return NEXT
 124 end)
 125
 126 EXIT = defPrim("EXIT", () -> begin
 127     IP = popRS()
 128     return NEXT
 129 end)
 130
 131
 132 # Basic forth primitives
 133
 134 DROP = defPrim("DROP", () -> begin
 135     popPS()
 136     return NEXT
 137 end)
 138
 139 SWAP = defPrim("SWAP", () -> begin
 140     PS[PSP], PS[PSP-1] = PS[PSP-1], PS[PS]
 141     return NEXT
 142 end)
 143
 144 DUP = defPrim("DUP", () -> begin
 145     pushPS(PS[PSP])
 146     return NEXT
 147 end)
 148
 149 LIT = defPrim("LIT", () -> begin
 150     pushPS(memory[IP])
 151     IP += 1
 152     return NEXT
 153 end)
 154
 155 # Memory primitives
 156
 157 STORE = defPrim("!", quote
 158     addr = popPS()
 159     dat = popPS()
 160     memory[addr] = dat
 161     return NEXT
 162 end)
 163
 164 FETCH = defPrim("@", quote
 165     addr = popPS()
 166     pushPS(memory[addr])
 167     return NEXT
 168 end)
 169
 170 ADDSTORE = defPrim("+!", quote
 171     addr = popPS()
 172     toAdd = popPS()
 173     memory[addr] += toAdd
 174     return NEXT
 175 end)
 176
 177 SUBSTORE = defPrim("-!", quote
 178     addr = popPS()
 179     toSub = popPS()
 180     memory[addr] -= toSub
 181     return NEXT
 182 end)
 183
 184
 185 # Built-in variables
 186
 187 defVar("STATE", :state)
 188 defVar("HERE", :here)
 189 defVar("LATEST", :latest)
 190 defVar("BASE", :base)
 191
 192 # Constants
 193
 194 defConst("VERSION", 1)
 195 defConst("DOCOL", DOCOL)
 196
 197 # Return Stack
 198
 199 TOR = defPrim(">R", () -> begin
 200     pushRS(popPS())
 201     return NEXT
 202 end)
 203
 204 FROMR = defPrim("R>", () -> begin
 205     pushPS(popRS())
 206     return NEXT
 207 end)
 208
 209 RSPFETCH = defPrim("RSP@", () -> begin
 210     pushPS(RSP)
 211     return NEXT
 212 end)
 213
 214 RSPSTORE = defPrim("RSP!", () -> begin
 215     RSP = popPS()
 216     return NEXT
 217 end)
 218
 219 RDROP = defPrim("RDROP", () -> begin
 220     popRS()
 221     return NEXT
 222 end)
 223
 224 # Parameter Stack
 225
 226 PSPFETCH = defPrim("PSP@", () -> begin
 227     pushPS(PSP)
 228     return NEXT
 229 end)
 230
 231 PSPSTORE = defPrim("PSP!", () -> begin
 232     PSP = popPS()
 233     return NEXT
 234 end)
 235
 236 # I/O
 237
 238 defConst("TIB", tib)
 239 defVar("#TIB", :numtib)
 240 defVar(">IN", :toin)
 241
 242 KEY = defPrim("KEY", () -> begin
 243     if toin >= numtib
 244
 245     end
 246
 247     return NEXT
 248 end)
 249
 250 EMIT = defPrim("EMIT", () -> begin
 251
 252     return NEXT
 253 end)
 254
 255 WORD = defPrim("WORD", () -> begin
 256
 257     return NEXT
 258 end)
 259
 260 NUMBER = defPrim("NUMBER", () -> begin
 261
 262     return NEXT
 263 end)
 264
 265 #### VM loop ####
 266 function runVM()
 267     jmp = NEXT
 268     while (jmp = callPrim(jmp)) != 0 end
 269 end
 270
 271 end