src/forth.jl

   1 module forth
   2
   3 # VM memory size
   4 size_memory = 640*1024
   5
   6 # Buffer sizes
   7 size_SysVar = 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 # memory = +-----------------------+
  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. Additionally, all
  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 # Built-in variables
  46
  47 nextVarAddr = 1
  48 RSP0 = nextVarAddr; nextVarAddr += 1
  49 PSP0 = nextVarAddr; nextVarAddr += 1
  50 HERE = nextVarAddr; nextVarAddr += 1
  51 LATEST = nextVarAddr; nextVarAddr += 1
  52
  53 memory[RSP0] = size_BIVar               # bottom of RS
  54 memory[PSP0] = memory[RSP0] + size_RS   # bottom of PS
  55 TIB = memory[PSP0] + size_PS            # address of terminal input buffer
  56 memory[HERE] = TIB + size_TIB           # location of bottom of dictionary
  57 memory[LATEST] = 0                      # no previous definition
  58
  59
  60 # Stack manipulation functions
  61
  62 function pushRS(reg::Reg, val::Int64)
  63     memory[reg.RSP+=1] = val
  64 end
  65
  66 function popRS(reg::Reg)
  67     val = memory[reg.RSP]
  68     reg.RSP -= 1
  69     return val
  70 end
  71
  72 function pushPS(reg::Reg, val::Int64)
  73     memory[reg.PSP += 1] = val
  74 end
  75
  76 function popPS(reg::Reg)
  77     val = memory[reg.PSP]
  78     reg.PSP -= 1
  79     return val
  80 end
  81
  82 # Primitive creation and calling functions
  83
  84 function defPrim(name::AbstractString, f::Function)
  85     global latest, here
  86
  87     memory[here] = latest
  88     latest = here
  89     here += 1
  90
  91     memory[here] = length(name); here += 1
  92     memory[here:(here+length(name)-1)] = [Int(c) for c in name]; here += length(name)
  93
  94     push!(primitives, f)
  95     memory[here] = -length(primitives)
  96     here += 1
  97
  98     return -length(primitives)
  99 end
 100
 101 callPrim(reg::Reg, addr::Int64) = primitives[-addr](reg)
 102
 103 function defSysVar(name::AbstractString, varAddr::Int64)
 104     global latest, here
 105
 106     memory[here] = latest
 107     latest = here
 108     here += 1
 109
 110     memory[here] = length(name); here += 1
 111     memory[here:(here+length(name)-1)] = [Int(c) for c in name]; here += length(name)
 112
 113     push!(primitives, eval(:((reg::Reg) -> begin
 114         pushPS(reg, $(varAddr))
 115         return NEXT
 116     end)))
 117     memory[here] = -length(primitives)
 118     here += 1
 119
 120     return varAddr
 121 end
 122
 123 defConst(name::AbstractString, val::Int64) = defSysVar(name, val)
 124
 125 # Threading Primitives
 126
 127 NEXT = defPrim("NEXT", (reg) -> begin
 128     reg.W = memory[reg.IP]
 129     reg.IP += 1
 130     X = memory[reg.W]
 131     return X
 132 end)
 133
 134 DOCOL = defPrim("DOCOL", (reg) -> begin
 135     pushRS(reg, reg.IP)
 136     reg.IP = reg.W + 1
 137     return NEXT
 138 end)
 139
 140 EXIT = defPrim("EXIT", (reg) -> begin
 141     reg.IP = popRS(reg)
 142     return NEXT
 143 end)
 144
 145
 146 # Basic forth primitives
 147
 148 DROP = defPrim("DROP", (reg) -> begin
 149     popPS(reg)
 150     return NEXT
 151 end)
 152
 153 SWAP = defPrim("SWAP", (reg) -> begin
 154     memory[reg.PSP], memory[reg.PSP-1] = memory[reg.PSP-1], memory[reg.PSP]
 155     return NEXT
 156 end)
 157
 158 DUP = defPrim("DUP", (reg) -> begin
 159     pushPS(reg, memory[reg.PSP])
 160     return NEXT
 161 end)
 162
 163 LIT = defPrim("LIT", (reg) -> begin
 164     pushPS(reg, memory[reg.IP])
 165     reg.IP += 1
 166     return NEXT
 167 end)
 168
 169 # Memory primitives
 170
 171 STORE = defPrim("!", (reg) -> begin
 172     addr = popPS(reg)
 173     dat = popPS(reg)
 174     memory[addr] = dat
 175     return NEXT
 176 end)
 177
 178 FETCH = defPrim("@", (reg) -> begin
 179     addr = popPS(reg)
 180     pushPS(reg, memory[addr])
 181     return NEXT
 182 end)
 183
 184 ADDSTORE = defPrim("+!", (reg) -> begin
 185     addr = popPS(reg)
 186     toAdd = popPS(reg)
 187     memory[addr] += toAdd
 188     return NEXT
 189 end)
 190
 191 SUBSTORE = defPrim("-!", (reg) -> begin
 192     addr = popPS(reg)
 193     toSub = popPS(reg)
 194     memory[addr] -= toSub
 195     return NEXT
 196 end)
 197
 198
 199 # Built-in variables
 200
 201
 202 # Constants
 203
 204 defConst("VERSION", 1)
 205 defConst("DOCOL", DOCOL)
 206
 207 # Return Stack
 208
 209 TOR = defPrim(">R", (reg) -> begin
 210     pushRS(reg, popPS(reg))
 211     return NEXT
 212 end)
 213
 214 FROMR = defPrim("R>", (reg) -> begin
 215     pushPS(reg, popRS(reg))
 216     return NEXT
 217 end)
 218
 219 RSPFETCH = defPrim("RSP@", (reg) -> begin
 220     pushPS(reg, RSP)
 221     return NEXT
 222 end)
 223
 224 RSPSTORE = defPrim("RSP!", (reg) -> begin
 225     RSP = popPS(reg)
 226     return NEXT
 227 end)
 228
 229 RDROP = defPrim("RDROP", (reg) -> begin
 230     popRS(reg)
 231     return NEXT
 232 end)
 233
 234 # Parameter Stack
 235
 236 PSPFETCH = defPrim("PSP@", (reg) -> begin
 237     pushPS(reg, PSP)
 238     return NEXT
 239 end)
 240
 241 PSPSTORE = defPrim("PSP!", (reg) -> begin
 242     PSP = popPS(reg)
 243     return NEXT
 244 end)
 245
 246 # I/O
 247
 248 defConst("TIB", tib)
 249 defVar("#TIB", :numtib)
 250 defVar(">IN", :toin)
 251
 252 KEY = defPrim("KEY", (reg) -> begin
 253     if toin >= numtib
 254
 255     end
 256
 257     return NEXT
 258 end)
 259
 260 EMIT = defPrim("EMIT", (reg) -> begin
 261
 262     return NEXT
 263 end)
 264
 265 WORD = defPrim("WORD", (reg) -> begin
 266
 267     return NEXT
 268 end)
 269
 270 NUMBER = defPrim("NUMBER", (reg) -> begin
 271
 272     return NEXT
 273 end)
 274
 275 #### VM loop ####
 276 function runVM(reg::Reg)
 277     jmp = NEXT
 278     while (jmp = callPrim(reg, jmp)) != 0 end
 279 end
 280
 281 end