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 # VM registers
  13 type Reg
  14     RSP::Int64  # Return stack pointer
  15     PSP::Int64  # Parameter/data stack pointer
  16     IP::Int64   # Instruction pointer
  17     W::Int64    # Working register
  18     X::Int64    # Extra register
  19 end
  20
  21 # The following array constitutes the memory of the VM. It has the following geography:
  22 #
  23 # mem = +-----------------------+
  24 #          | Built-in Variables    |
  25 #          +-----------------------+
  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 mem = Array{Int64,1}(size_mem)
  43 primitives = Array{Function,1}()
  44
  45 # Built-in variables
  46
  47 nextVarAddr = 1
  48 RSP0 = nextVarAddr; nextVarAddr += 1
  49 PSP0 = nextVarAddr; nextVarAddr += 1
  50 TIB = nextVarAddr; nextVarAddr += 1
  51 HERE = nextVarAddr; nextVarAddr += 1
  52 LATEST = nextVarAddr; nextVarAddr += 1
  53
  54 mem[RSP0] = size_BIVar               # bottom of RS
  55 mem[PSP0] = mem[RSP0] + size_RS      # bottom of PS
  56 mem[TIB] = mem[PSP0] + size_PS            # address of terminal input buffer
  57 mem[HERE] = mem[TIB] + size_TIB           # location of bottom of dictionary
  58 mem[LATEST] = 0                      # no previous definition
  59
  60 # Stack manipulation functions
  61
  62 function pushRS(reg::Reg, val::Int64)
  63     mem[reg.RSP+=1] = val
  64 end
  65
  66 function popRS(reg::Reg)
  67     val = mem[reg.RSP]
  68     reg.RSP -= 1
  69     return val
  70 end
  71
  72 function pushPS(reg::Reg, val::Int64)
  73     mem[reg.PSP += 1] = val
  74 end
  75
  76 function popPS(reg::Reg)
  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)
  85     mem[mem[HERE]] = mem[LATEST]
  86     mem[LATEST] = mem[HERE]
  87     mem[HERE] += 1
  88
  89     mem[mem[HERE]] = length(name); 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)
  94     createHeader(name)
  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(reg::Reg, addr::Int64) = primitives[-addr](reg)
 104
 105 defExistingVar(name::AbstractString, varAddr::Int64) = defPrim(name, eval(:((reg) -> begin
 106     pushPS(reg, $(varAddr))
 107     return NEXT
 108 end)))
 109
 110 defConst(name::AbstractString, val::Int64) = defPrim(name, eval(:((reg) -> begin
 111     pushPS(reg, $(val))
 112     return NEXT
 113 end)))
 114
 115 function defNewVar(name::AbstractString, initial::Int64)
 116     createHeader(name)
 117
 118     varAddr = mem[HERE] + 1
 119     push!(primitives, eval(:((reg) -> begin
 120         pushPS(reg, $(varAddr))
 121         return NEXT
 122     end)))
 123     mem[mem[HERE]] = -length(primitives); mem[HERE] += 1
 124
 125     mem[mem[HERE]] = inital; mem[HERE] += 1
 126
 127     return varAddr
 128 end
 129
 130 # Threading Primitives
 131
 132 NEXT = defPrim("NEXT", (reg) -> begin
 133     reg.W = mem[reg.IP]
 134     reg.IP += 1
 135     X = mem[reg.W]
 136     return X
 137 end)
 138
 139 DOCOL = defPrim("DOCOL", (reg) -> begin
 140     pushRS(reg, reg.IP)
 141     reg.IP = reg.W + 1
 142     return NEXT
 143 end)
 144
 145 EXIT = defPrim("EXIT", (reg) -> begin
 146     reg.IP = popRS(reg)
 147     return NEXT
 148 end)
 149
 150
 151 # Basic forth primitives
 152
 153 DROP = defPrim("DROP", (reg) -> begin
 154     popPS(reg)
 155     return NEXT
 156 end)
 157
 158 SWAP = defPrim("SWAP", (reg) -> begin
 159     mem[reg.PSP], mem[reg.PSP-1] = mem[reg.PSP-1], mem[reg.PSP]
 160     return NEXT
 161 end)
 162
 163 DUP = defPrim("DUP", (reg) -> begin
 164     pushPS(reg, mem[reg.PSP])
 165     return NEXT
 166 end)
 167
 168 LIT = defPrim("LIT", (reg) -> begin
 169     pushPS(reg, mem[reg.IP])
 170     reg.IP += 1
 171     return NEXT
 172 end)
 173
 174 # Memory primitives
 175
 176 STORE = defPrim("!", (reg) -> begin
 177     addr = popPS(reg)
 178     dat = popPS(reg)
 179     mem[addr] = dat
 180     return NEXT
 181 end)
 182
 183 FETCH = defPrim("@", (reg) -> begin
 184     addr = popPS(reg)
 185     pushPS(reg, mem[addr])
 186     return NEXT
 187 end)
 188
 189 ADDSTORE = defPrim("+!", (reg) -> begin
 190     addr = popPS(reg)
 191     toAdd = popPS(reg)
 192     mem[addr] += toAdd
 193     return NEXT
 194 end)
 195
 196 SUBSTORE = defPrim("-!", (reg) -> begin
 197     addr = popPS(reg)
 198     toSub = popPS(reg)
 199     mem[addr] -= toSub
 200     return NEXT
 201 end)
 202
 203
 204 # Built-in variables
 205
 206 defExistingVar("HERE", HERE)
 207 defExistingVar("LATEST", LATEST)
 208 defExistingVar("PSP0", PSP0)
 209 defExistingVar("RSP0", RSP0)
 210 defNewVar("STATE", 0)
 211 defNewVar("BASE", 10)
 212
 213 # Constants
 214
 215 defConst("VERSION", 1)
 216 defConst("DOCOL", DOCOL)
 217
 218 # Return Stack
 219
 220 TOR = defPrim(">R", (reg) -> begin
 221     pushRS(reg, popPS(reg))
 222     return NEXT
 223 end)
 224
 225 FROMR = defPrim("R>", (reg) -> begin
 226     pushPS(reg, popRS(reg))
 227     return NEXT
 228 end)
 229
 230 RSPFETCH = defPrim("RSP@", (reg) -> begin
 231     pushPS(reg, RSP)
 232     return NEXT
 233 end)
 234
 235 RSPSTORE = defPrim("RSP!", (reg) -> begin
 236     RSP = popPS(reg)
 237     return NEXT
 238 end)
 239
 240 RDROP = defPrim("RDROP", (reg) -> begin
 241     popRS(reg)
 242     return NEXT
 243 end)
 244
 245 # Parameter Stack
 246
 247 PSPFETCH = defPrim("PSP@", (reg) -> begin
 248     pushPS(reg, PSP)
 249     return NEXT
 250 end)
 251
 252 PSPSTORE = defPrim("PSP!", (reg) -> begin
 253     PSP = popPS(reg)
 254     return NEXT
 255 end)
 256
 257 # I/O
 258
 259 #defConst("TIB", tib)
 260 #defVar("#TIB", :numtib)
 261 #defVar(">IN", :toin)
 262 #
 263 #KEY = defPrim("KEY", (reg) -> begin
 264 #    if toin >= numtib
 265 #
 266 #    end
 267 #
 268 #    return NEXT
 269 #end)
 270 #
 271 #EMIT = defPrim("EMIT", (reg) -> begin
 272 #
 273 #    return NEXT
 274 #end)
 275 #
 276 #WORD = defPrim("WORD", (reg) -> begin
 277 #
 278 #    return NEXT
 279 #end)
 280 #
 281 #NUMBER = defPrim("NUMBER", (reg) -> begin
 282 #
 283 #    return NEXT
 284 #end)
 285 #
 286 #### VM loop ####
 287 #function runVM(reg::Reg)
 288 #    jmp = NEXT
 289 #    while (jmp = callPrim(reg, jmp)) != 0 end
 290 #end
 291
 292 # Debugging tools
 293
 294 function coredump(startAddr::Int64; count::Int64 = 16, cellsPerLine::Int64 = 8)
 295     chars = Array{Char,1}(cellsPerLine)
 296
 297     for i in 0:(count-1)
 298         addr = startAddr + i
 299         if i%cellsPerLine == 0
 300             print("$addr:")
 301         end
 302
 303         print("\t$(mem[addr]) ")
 304
 305         if (mem[addr]>=32 && mem[addr]<176)
 306             chars[i%cellsPerLine + 1] = Char(mem[addr])
 307         else
 308             chars[i%cellsPerLine + 1] = '.'
 309         end
 310
 311         if i%cellsPerLine == cellsPerLine-1
 312             println(string("\t", ASCIIString(chars)))
 313         end
 314     end
 315 end
 316
 317 end