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 # Treat newline as a special word
590 mem[wordAddr + offset] = Int64(c)
597 mem[wordAddr + offset] = Int64(c)
603 if c == ' ' || c == '\t' || c == '\n'
618 NUMBER = defPrim("NUMBER", () -> begin
623 s = getString(wordAddr, wordLen)
626 pushPS(parse(Int64, s, mem[BASE]))
629 pushPS(1) # Error indication
635 # Dictionary searches
637 FIND = defPrim("FIND", () -> begin
641 word = lowercase(getString(wordAddr, wordLen))
646 while (latest = mem[latest]) > 0
647 lenAndFlags = mem[latest+1]
648 len = lenAndFlags & F_LENMASK
649 hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
651 if hidden || len != wordLen
656 thisWord = lowercase(getString(thisAddr, len))
658 if lowercase(thisWord) == lowercase(word)
668 TOCFA = defPrim(">CFA", () -> begin
671 lenAndFlags = mem[addr+1]
672 len = lenAndFlags & F_LENMASK
674 pushPS(addr + 2 + len)
679 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
683 CREATE = defPrim("CREATE", () -> begin
687 word = getString(wordAddr, wordLen)
689 createHeader(word, 0)
694 COMMA = defPrim(",", () -> begin
695 mem[mem[HERE]] = popPS()
701 LBRAC = defPrim("[", () -> begin
706 RBRAC = defPrim("]", () -> begin
711 HIDDEN = defPrim("HIDDEN", () -> begin
713 mem[addr] = mem[addr] $ F_HIDDEN
717 HIDE = defWord("HIDE",
727 LATEST, FETCH, HIDDEN,
731 SEMICOLON = defWord(";",
733 LATEST, FETCH, HIDDEN,
735 EXIT], flags=F_IMMED)
737 IMMEDIATE = defPrim("IMMEDIATE", () -> begin
738 lenAndFlagsAddr = mem[LATEST] + 1
739 mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
743 TICK = defWord("'", [WORD, FIND, TOCFA, EXIT])
747 BRANCH = defPrim("BRANCH", () -> begin
748 reg.IP += mem[reg.IP]
752 ZBRANCH = defPrim("0BRANCH", () -> begin
754 reg.IP += mem[reg.IP]
764 LITSTRING = defPrim("LITSTRING", () -> begin
774 TELL = defPrim("TELL", () -> begin
777 str = getString(addr, len)
784 INTERPRET = defPrim("INTERPRET", () -> begin
788 wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
789 println("... ", replace(wordName, "\n", "\\n"), " ...")
791 callPrim(mem[TWODUP])
794 wordAddr = mem[reg.PSP]
800 isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
803 callPrim(mem[ROT]) # get rid of extra copy of word string details
807 if mem[STATE] == 0 || isImmediate
811 # Append CFA to dictionary
815 # Not in dictionary, assume number
819 callPrim(mem[NUMBER])
822 println("Parse error at word: '$wordName'")
828 # Number already on stack!
830 # Append literal to dictionary
840 QUIT = defWord("QUIT",
845 NL = defPrim("\n", () -> begin
854 CHAR = defPrim("CHAR", () -> begin
858 word = getString(wordAddr, wordLen)
859 pushPS(Int64(word[1]))
864 EXECUTE = defPrim("EXECUTE", () -> begin
868 BYE = defPrim("BYE", () -> begin
874 # Start with IP pointing to first instruction of outer interpreter
877 # Primitive processing loop.
878 # Everyting else is simply a consequence of this loop!
880 while (jmp = callPrim(jmp)) != 0
881 println("Evaluating prim $jmp")
887 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
888 chars = Array{Char,1}(cellsPerLine)
890 lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
891 endAddr = startAddr + count - 1
893 q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
894 numLines = q + (r > 0 ? 1 : 0)
900 for c in 1:cellsPerLine
901 if i >= startAddr && i <= endAddr
903 if mem[i]>=32 && mem[i]<128
904 chars[c] = Char(mem[i])
916 println("\t", ASCIIString(chars))
921 count = reg.PSP - mem[PSP0]
925 for i in (mem[PSP0]+1):reg.PSP
930 println("Parameter stack empty")
935 count = reg.RSP - mem[RSP0]
939 for i in (mem[RSP0]+1):reg.RSP
944 println("Return stack empty")