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