src/forth.jl

   1 module forth
   2
   3 # VM mem size
   4 size_mem = 640*1024
   5
   6 # Buffer sizes
   7 size_BIVar = 16 #
   8 size_RS = 1024   # Return stack size
   9 size_PS = 1024   # Parameter stack size
  10 size_TIB = 4096  # Terminal input buffer size
  11
  12 # The mem array constitutes the memory of the VM. It has the following geography:
  13 #
  14 # mem = +-----------------------+
  15 #       | Built-in Variables    |
  16 #       +-----------------------+
  17 #       | Return Stack          |
  18 #       +-----------------------+
  19 #       | Parameter Stack       |
  20 #       +-----------------------+
  21 #       | Terminal Input Buffer |
  22 #       +-----------------------+
  23 #       | Dictionary            |
  24 #       +-----------------------+
  25 #
  26 # Note that all words (user-defined, primitive, variables, etc) are included in
  27 # the dictionary.
  28 #
  29 # Simple linear addressing is used with one exception: references to primitive code
  30 # blocks, which are represented as anonymous functions, appear the negative index
  31 # into the primitives array which contains only these functions.
  32
  33 mem = Array{Int64,1}(size_mem)
  34 primitives = Array{Function,1}()
  35
  36 # Built-in variables
  37
  38 nextVarAddr = 1
  39 RSP0 = nextVarAddr; nextVarAddr += 1
  40 PSP0 = nextVarAddr; nextVarAddr += 1
  41 HERE = nextVarAddr; nextVarAddr += 1
  42 LATEST = nextVarAddr; nextVarAddr += 1
  43
  44 mem[RSP0] = size_BIVar               # bottom of RS
  45 mem[PSP0] = mem[RSP0] + size_RS      # bottom of PS
  46 TIB = mem[PSP0] + size_PS            # address of terminal input buffer
  47 mem[HERE] = TIB + size_TIB           # location of bottom of dictionary
  48 mem[LATEST] = 0                      # no previous definition
  49
  50 # VM registers
  51 type Reg
  52     RSP::Int64  # Return stack pointer
  53     PSP::Int64  # Parameter/data stack pointer
  54     IP::Int64   # Instruction pointer
  55     W::Int64    # Working register
  56     X::Int64    # Extra register
  57 end
  58 reg = Reg(mem[RSP0], mem[PSP0], 0, 0, 0)
  59
  60 # Stack manipulation functions
  61
  62 function pushRS(val::Int64)
  63     mem[reg.RSP+=1] = val
  64 end
  65
  66 function popRS()
  67     val = mem[reg.RSP]
  68     reg.RSP -= 1
  69     return val
  70 end
  71
  72 function pushPS(val::Int64)
  73     mem[reg.PSP += 1] = val
  74 end
  75
  76 function popPS()
  77     val = mem[reg.PSP]
  78     reg.PSP -= 1
  79     return val
  80 end
  81
  82 # Primitive creation and calling functions
  83
  84 function createHeader(name::AbstractString, flags::Int64)
  85     mem[mem[HERE]] = mem[LATEST]
  86     mem[LATEST] = mem[HERE]
  87     mem[HERE] += 1
  88
  89     mem[mem[HERE]] = length(name) + flags; mem[HERE] += 1
  90     mem[mem[HERE]:(mem[HERE]+length(name)-1)] = [Int(c) for c in name]; mem[HERE] += length(name)
  91 end
  92
  93 function defPrim(name::AbstractString, f::Function; flags::Int64=0)
  94     createHeader(name, flags)
  95
  96     push!(primitives, f)
  97     mem[mem[HERE]] = -length(primitives)
  98     mem[HERE] += 1
  99
 100     return -length(primitives)
 101 end
 102
 103 callPrim(addr::Int64) = primitives[-addr]()
 104
 105 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
 106     defPrim(name, eval(:(() -> begin
 107         pushPS($(varAddr))
 108         return NEXT
 109     end)))
 110 end
 111
 112 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
 113     defPrim(name, eval(:(() -> begin
 114         pushPS($(val))
 115         return NEXT
 116     end)))
 117 end
 118
 119 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
 120     createHeader(name, flags)
 121
 122     varAddr = mem[HERE] + 1
 123     push!(primitives, eval(:(() -> begin
 124         pushPS($(varAddr))
 125         return NEXT
 126     end)))
 127     mem[mem[HERE]] = -length(primitives); mem[HERE] += 1
 128
 129     mem[mem[HERE]] = initial; mem[HERE] += 1
 130
 131     return varAddr
 132 end
 133
 134 # Threading Primitives
 135
 136 NEXT = defPrim("NEXT", () -> begin
 137     reg.W = mem[reg.IP]
 138     reg.IP += 1
 139     X = mem[reg.W]
 140     return X
 141 end)
 142
 143 DOCOL = defPrim("DOCOL", () -> begin
 144     pushRS(reg.IP)
 145     reg.IP = reg.W + 1
 146     return NEXT
 147 end)
 148
 149 EXIT = defPrim("EXIT", () -> begin
 150     reg.IP = popRS()
 151     return NEXT
 152 end)
 153
 154
 155 # Basic forth primitives
 156
 157 DROP = defPrim("DROP", () -> begin
 158     popPS()
 159     return NEXT
 160 end)
 161
 162 SWAP = defPrim("SWAP", () -> begin
 163     mem[reg.PSP], mem[reg.PSP-1] = mem[reg.PSP-1], mem[reg.PSP]
 164     return NEXT
 165 end)
 166
 167 DUP = defPrim("DUP", () -> begin
 168     pushPS(mem[reg.PSP])
 169     return NEXT
 170 end)
 171
 172 LIT = defPrim("LIT", () -> begin
 173     pushPS(mem[reg.IP])
 174     reg.IP += 1
 175     return NEXT
 176 end)
 177
 178 # Memory primitives
 179
 180 STORE = defPrim("!", () -> begin
 181     addr = popPS()
 182     dat = popPS()
 183     mem[addr] = dat
 184     return NEXT
 185 end)
 186
 187 FETCH = defPrim("@", () -> begin
 188     addr = popPS()
 189     pushPS(mem[addr])
 190     return NEXT
 191 end)
 192
 193 ADDSTORE = defPrim("+!", () -> begin
 194     addr = popPS()
 195     toAdd = popPS()
 196     mem[addr] += toAdd
 197     return NEXT
 198 end)
 199
 200 SUBSTORE = defPrim("-!", () -> begin
 201     addr = popPS()
 202     toSub = popPS()
 203     mem[addr] -= toSub
 204     return NEXT
 205 end)
 206
 207
 208 # Built-in variables
 209
 210 defExistingVar("HERE", HERE)
 211 defExistingVar("LATEST", LATEST)
 212 defExistingVar("PSP0", PSP0)
 213 defExistingVar("RSP0", RSP0)
 214 defNewVar("STATE", 0)
 215 defNewVar("BASE", 10)
 216
 217 # Constants
 218
 219 defConst("VERSION", 1)
 220 defConst("DOCOL", DOCOL)
 221
 222 # Return Stack
 223
 224 TOR = defPrim(">R", () -> begin
 225     pushRS(popPS())
 226     return NEXT
 227 end)
 228
 229 FROMR = defPrim("R>", () -> begin
 230     pushPS(popRS())
 231     return NEXT
 232 end)
 233
 234 RSPFETCH = defPrim("RSP@", () -> begin
 235     pushPS(RSP)
 236     return NEXT
 237 end)
 238
 239 RSPSTORE = defPrim("RSP!", () -> begin
 240     RSP = popPS()
 241     return NEXT
 242 end)
 243
 244 RDROP = defPrim("RDROP", () -> begin
 245     popRS()
 246     return NEXT
 247 end)
 248
 249 # Parameter Stack
 250
 251 PSPFETCH = defPrim("PSP@", () -> begin
 252     pushPS(PSP)
 253     return NEXT
 254 end)
 255
 256 PSPSTORE = defPrim("PSP!", () -> begin
 257     PSP = popPS()
 258     return NEXT
 259 end)
 260
 261 # I/O
 262
 263 defConst("TIB", TIB)
 264 NUMTIB = defNewVar("#TIB", 0)
 265 TOIN = defNewVar(">IN", TIB)
 266
 267 #KEY = defPrim("KEY", (reg) -> begin
 268 #    if toin >= numtib
 269 #
 270 #    end
 271 #
 272 #    return NEXT
 273 #end)
 274 #
 275 #EMIT = defPrim("EMIT", (reg) -> begin
 276 #
 277 #    return NEXT
 278 #end)
 279 #
 280 #WORD = defPrim("WORD", (reg) -> begin
 281 #
 282 #    return NEXT
 283 #end)
 284 #
 285 #NUMBER = defPrim("NUMBER", (reg) -> begin
 286 #
 287 #    return NEXT
 288 #end)
 289 #
 290 #### VM loop ####
 291 #function runVM(reg::Reg)
 292 #    jmp = NEXT
 293 #    while (jmp = callPrim(reg, jmp)) != 0 end
 294 #end
 295
 296 # Debugging tools
 297
 298 function coredump(startAddr::Int64; count::Int64 = 16, cellsPerLine::Int64 = 8)
 299     chars = Array{Char,1}(cellsPerLine)
 300
 301     for i in 0:(count-1)
 302         addr = startAddr + i
 303         if i%cellsPerLine == 0
 304             print("$addr:")
 305         end
 306
 307         print("\t$(mem[addr]) ")
 308
 309         if (mem[addr]>=32 && mem[addr]<176)
 310             chars[i%cellsPerLine + 1] = Char(mem[addr])
 311         else
 312             chars[i%cellsPerLine + 1] = '.'
 313         end
 314
 315         if i%cellsPerLine == cellsPerLine-1
 316             println(string("\t", ASCIIString(chars)))
 317         end
 318     end
 319 end
 320
 321 function dumpPS()
 322     count = reg.PSP - mem[PSP0]
 323
 324     if count > 0
 325         print("<$count>")
 326         for i in (mem[PSP0]+1):reg.PSP
 327             print(" $(mem[i])")
 328         end
 329         println()
 330     else
 331         println("Parameter stack empty")
 332     end
 333 end
 334
 335 end