7 size_RS = 1024 # Return stack size
8 size_PS = 1024 # Parameter stack size
9 size_TIB = 1096 # Terminal input buffer size
11 # The mem array constitutes the memory of the VM. It has the following geography:
13 # mem = +-----------------------+
14 # | Built-in Variables |
15 # +-----------------------+
17 # +-----------------------+
19 # +-----------------------+
20 # | Terminal Input Buffer |
21 # +-----------------------+
23 # +-----------------------+
25 # Note that all words (user-defined, primitive, variables, etc) are included in
28 # Simple linear addressing is used with one exception: references to primitive code
29 # blocks, which are represented as anonymous functions, appear the negative index
30 # into the primitives array which contains only these functions.
32 mem = Array{Int64,1}(size_mem)
33 primitives = Array{Function,1}()
38 RSP0 = nextVarAddr; nextVarAddr += 1
39 PSP0 = nextVarAddr; nextVarAddr += 1
40 HERE = nextVarAddr; nextVarAddr += 1
41 LATEST = nextVarAddr; nextVarAddr += 1
43 mem[RSP0] = nextVarAddr # bottom of RS
44 mem[PSP0] = mem[RSP0] + size_RS # bottom of PS
45 TIB = mem[PSP0] + size_PS # address of terminal input buffer
46 mem[HERE] = TIB + size_TIB # location of bottom of dictionary
47 mem[LATEST] = 0 # no previous definition
49 DICT = mem[HERE] # Save bottom of dictionary as constant
53 RSP::Int64 # Return stack pointer
54 PSP::Int64 # Parameter/data stack pointer
55 IP::Int64 # Instruction pointer
56 W::Int64 # Working register
57 X::Int64 # Extra register
59 reg = Reg(mem[RSP0], mem[PSP0], 0, 0, 0)
63 type StackUnderflow <: Exception end
65 getRSDepth() = reg.RSP - mem[RSP0]
66 getPSDepth() = reg.PSP - mem[PSP0]
68 function ensurePSDepth(depth::Int64)
70 throw(StackUnderflow())
74 function ensureRSDepth(depth::Int64)
76 throw(StackUnderflow())
80 function pushRS(val::Int64)
92 function pushPS(val::Int64)
93 mem[reg.PSP += 1] = val
104 # Handy functions for adding/retrieving strings to/from memory.
106 getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
107 function putString(str::ASCIIString, addr::Int64)
108 mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
111 # Primitive creation and calling functions
113 function createHeader(name::AbstractString, flags::Int64)
114 mem[mem[HERE]] = mem[LATEST]
115 mem[LATEST] = mem[HERE]
118 mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1
119 putString(name, mem[HERE]); mem[HERE] += length(name)
122 function defPrim(name::AbstractString, f::Function; flags::Int64=0)
123 createHeader(name, flags)
125 codeWordAddr = mem[HERE]
127 mem[codeWordAddr] = -length(primitives)
133 callPrim(addr::Int64) = primitives[-addr]()
135 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
136 defPrim(name, eval(:(() -> begin
142 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
143 createHeader(name, flags)
145 codeWordAddr = mem[HERE]
146 varAddr = mem[HERE] + 1
147 push!(primitives, eval(:(() -> begin
151 mem[mem[HERE]] = -length(primitives); mem[HERE] += 1
153 mem[mem[HERE]] = initial; mem[HERE] += 1
155 return varAddr, codeWordAddr
158 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
159 defPrim(name, eval(:(() -> begin
167 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
168 createHeader(name, flags)
171 mem[mem[HERE]] = mem[DOCOL]
174 for wordAddr in wordAddrs
175 mem[mem[HERE]] = wordAddr
182 # Threading Primitives (inner interpreter)
184 NEXT = defPrim("NEXT", () -> begin
190 DOCOL = defPrim("DOCOL", () -> begin
196 EXIT = defPrim("EXIT", () -> begin
201 # Basic forth primitives
203 DROP = defPrim("DROP", () -> begin
208 SWAP = defPrim("SWAP", () -> begin
216 DUP = defPrim("DUP", () -> begin
221 OVER = defPrim("OVER", () -> begin
223 pushPS(mem[reg.PSP-1])
227 ROT = defPrim("ROT", () -> begin
237 NROT = defPrim("-ROT", () -> begin
247 TWODROP = defPrim("2DROP", () -> begin
253 TWODUP = defPrim("2DUP", () -> begin
262 TWOSWAP = defPrim("2SWAP", () -> begin
274 QDUP = defPrim("?DUP", () -> begin
283 INCR = defPrim("1+", () -> begin
289 DECR = defPrim("1-", () -> begin
295 INCR2 = defPrim("2+", () -> begin
301 DECR2 = defPrim("2-", () -> begin
307 ADD = defPrim("+", () -> begin
314 SUB = defPrim("-", () -> begin
321 MUL = defPrim("*", () -> begin
328 DIVMOD = defPrim("/MOD", () -> begin
337 EQU = defPrim("=", () -> begin
340 pushPS(a==b ? -1 : 0)
344 NEQU = defPrim("<>", () -> begin
347 pushPS(a!=b ? -1 : 0)
351 LT = defPrim("<", () -> begin
358 GT = defPrim(">", () -> begin
365 LE = defPrim("<=", () -> begin
368 pushPS(a<=b ? -1 : 0)
372 GE = defPrim(">=", () -> begin
375 pushPS(a>=b ? -1 : 0)
379 ZEQU = defPrim("0=", () -> begin
380 pushPS(popPS() == 0 ? -1 : 0)
384 ZNEQU = defPrim("0<>", () -> begin
385 pushPS(popPS() != 0 ? -1 : 0)
389 ZLT = defPrim("0<", () -> begin
390 pushPS(popPS() < 0 ? -1 : 0)
394 ZGT = defPrim("0>", () -> begin
395 pushPS(popPS() > 0 ? -1 : 0)
399 ZLE = defPrim("0<=", () -> begin
400 pushPS(popPS() <= 0 ? -1 : 0)
404 ZGE = defPrim("0>=", () -> begin
405 pushPS(popPS() >= 0 ? -1 : 0)
409 AND = defPrim("AND", () -> begin
416 OR = defPrim("OR", () -> begin
423 XOR = defPrim("XOR", () -> begin
430 INVERT = defPrim("INVERT", () -> begin
437 LIT = defPrim("LIT", () -> begin
445 STORE = defPrim("!", () -> begin
452 FETCH = defPrim("@", () -> begin
458 ADDSTORE = defPrim("+!", () -> begin
465 SUBSTORE = defPrim("-!", () -> begin
475 HERE_CFA = defExistingVar("HERE", HERE)
476 LATEST_CFA = defExistingVar("LATEST", LATEST)
477 PSP0_CFA = defExistingVar("PSP0", PSP0)
478 RSP0_CFA = defExistingVar("RSP0", RSP0)
479 STATE, STATE_CFA = defNewVar("STATE", 0)
480 BASE, BASE_CFA = defNewVar("BASE", 10)
484 defConst("VERSION", 1)
485 defConst("DOCOL", DOCOL)
486 defConst("DICT", DICT)
487 F_IMMED = defConst("F_IMMED", 128)
488 F_HIDDEN = defConst("F_HIDDEN", 256)
489 F_LENMASK = defConst("F_LENMASK", 127)
493 TOR = defPrim(">R", () -> begin
498 FROMR = defPrim("R>", () -> begin
503 RSPFETCH = defPrim("RSP@", () -> begin
508 RSPSTORE = defPrim("RSP!", () -> begin
513 RDROP = defPrim("RDROP", () -> begin
520 PSPFETCH = defPrim("PSP@", () -> begin
525 PSPSTORE = defPrim("PSP!", () -> begin
533 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
534 TOIN, TOIN_CFA = defNewVar(">IN", 0)
536 KEY = defPrim("KEY", () -> begin
537 if mem[TOIN] >= mem[NUMTIB]
540 mem[NUMTIB] = length(line)
544 pushPS(mem[TIB + mem[TOIN]])
550 EMIT = defPrim("EMIT", () -> begin
555 WORD = defPrim("WORD", () -> begin
577 if c == ' ' || c == '\t'
588 mem[wordAddr + offset] = Int64(c)
594 if c == ' ' || c == '\t' || c == '\n'
607 NUMBER = defPrim("NUMBER", () -> begin
612 s = getString(wordAddr, wordLen)
615 pushPS(parse(Int64, s, mem[BASE]))
618 pushPS(1) # Error indication
624 # Dictionary searches
626 FIND = defPrim("FIND", () -> begin
630 word = getString(wordAddr, wordLen)
635 while (latest = mem[latest]) > 0
636 lenAndFlags = mem[latest+1]
637 len = lenAndFlags & F_LENMASK
638 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
640 if hidden || len != wordLen
645 thisWord = getString(thisAddr, len)
657 TOCFA = defPrim(">CFA", () -> begin
660 lenAndFlags = mem[addr+1]
661 len = lenAndFlags & F_LENMASK
663 pushPS(addr + 2 + len)
668 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
672 CREATE = defPrim("CREATE", () -> begin
676 word = getString(wordAddr, wordLen)
678 createHeader(word, 0)
683 COMMA = defPrim(",", () -> begin
684 mem[mem[HERE]] = popPS()
690 LBRAC = defPrim("[", () -> begin
695 RBRAC = defPrim("]", () -> begin
700 HIDDEN = defPrim("HIDDEN", () -> begin
702 mem[addr] = mem[addr] $ F_HIDDEN
706 HIDE = defWord("HIDE",
716 LATEST, FETCH, HIDDEN,
720 SEMICOLON = defWord(";",
722 LATEST, FETCH, HIDDEN,
724 EXIT], flags=F_IMMED)
726 IMMEDIATE = defPrim("IMMEDIATE", () -> begin
727 lenAndFlagsAddr = mem[LATEST] + 1
728 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
732 TICK = defWord("'", [WORD, FIND, TOCFA, EXIT])
736 BRANCH = defPrim("BRANCH", () -> begin
737 reg.IP += mem[reg.IP]
741 ZBRANCH = defPrim("0BRANCH", () -> begin
743 reg.IP += mem[reg.IP]
753 LITSTRING = defPrim("LITSTRING", () -> begin
763 TELL = defPrim("TELL", () -> begin
766 str = getString(addr, len)
773 INTERPRET = defPrim("INTERPRET", () -> begin
778 wordAddr = mem[reg.PSP]
783 lenAndFlags = mem[wordAddr+1]
794 QUIT = defWord("QUIT",
802 while (jmp = callPrim(jmp)) != 0 end
807 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
808 chars = Array{Char,1}(cellsPerLine)
810 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
811 endAddr = startAddr + count - 1
813 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
814 numLines = q + (r > 0 ? 1 : 0)
820 for c in 1:cellsPerLine
821 if i >= startAddr && i <= endAddr
823 if mem[i]>=32 && mem[i]<128
824 chars[c] = Char(mem[i])
836 println("\t", ASCIIString(chars))
841 count = reg.PSP - mem[PSP0]
845 for i in (mem[PSP0]+1):reg.PSP
850 println("Parameter stack empty")
855 count = reg.RSP - mem[RSP0]
859 for i in (mem[RSP0]+1):reg.RSP
864 println("Return stack empty")