Fixed residual INTERPRET bugs. Closes #3.
[forth.jl.git] / src / forth.jl
1 module forth
2
3 # VM mem size
4 size_mem = 1000000 # 1 mega-int
5
6 # Buffer sizes
7 size_RS = 1000   # Return stack size
8 size_PS = 1000   # Parameter stack size
9 size_TIB = 1000  # Terminal input buffer size
10
11 # The mem array constitutes the memory of the VM. It has the following geography:
12 #
13 # mem = +-----------------------+
14 #       | Built-in Variables    |
15 #       +-----------------------+
16 #       | Return Stack          |
17 #       +-----------------------+
18 #       | Parameter Stack       |
19 #       +-----------------------+
20 #       | Terminal Input Buffer |
21 #       +-----------------------+
22 #       | Dictionary            |
23 #       +-----------------------+
24 #
25 # Note that all words (user-defined, primitive, variables, etc) are included in
26 # the dictionary.
27 #
28 # Simple linear addressing is used with one exception: references to primitive code
29 # blocks, which are represented as anonymous functions, appear as negative indicies
30 # into the primitives array which contains these functions.
31
32 mem = Array{Int64,1}(size_mem)
33 primitives = Array{Function,1}()
34 primNames = Array{ASCIIString,1}()
35
36 # Built-in variables
37
38 nextVarAddr = 1
39 RSP0 = nextVarAddr; nextVarAddr += 1
40 PSP0 = nextVarAddr; nextVarAddr += 1
41 HERE = nextVarAddr; nextVarAddr += 1
42 LATEST = nextVarAddr; nextVarAddr += 1
43
44 mem[RSP0] = nextVarAddr              # bottom of RS
45 mem[PSP0] = mem[RSP0] + size_RS      # bottom of PS
46 TIB = mem[PSP0] + size_PS            # address of terminal input buffer
47 mem[HERE] = TIB + size_TIB           # location of bottom of dictionary
48 mem[LATEST] = 0                      # no previous definition
49
50 DICT = mem[HERE] # Save bottom of dictionary as constant
51
52 # VM registers
53 type Reg
54     RSP::Int64  # Return stack pointer
55     PSP::Int64  # Parameter/data stack pointer
56     IP::Int64   # Instruction pointer
57     W::Int64    # Working register
58 end
59 reg = Reg(mem[RSP0], mem[PSP0], 0, 0)
60
61 # Stack manipulation functions
62
63 type ParamStackUnderflow <: Exception end
64 type ReturnStackUnderflow <: Exception end
65
66 Base.showerror(io::IO, ex::ParamStackUnderflow) = print(io, "Parameter stack underflow.")
67 Base.showerror(io::IO, ex::ReturnStackUnderflow) = print(io, "Return stack underflow.")
68
69 getRSDepth() = reg.RSP - mem[RSP0]
70 getPSDepth() = reg.PSP - mem[PSP0]
71
72 function ensurePSDepth(depth::Int64)
73     if getPSDepth()<depth
74         throw(ParamStackUnderflow())
75     end
76 end
77
78 function ensureRSDepth(depth::Int64)
79     if getRSDepth()<depth
80         throw(ReturnStackUnderflow())
81     end
82 end
83
84 function pushRS(val::Int64)
85     mem[reg.RSP+=1] = val
86 end
87
88 function popRS()
89     ensureRSDepth(1)
90
91     val = mem[reg.RSP]
92     reg.RSP -= 1
93     return val
94 end
95
96 function pushPS(val::Int64)
97     mem[reg.PSP += 1] = val
98 end
99
100 function popPS()
101     ensurePSDepth(1)
102
103     val = mem[reg.PSP]
104     reg.PSP -= 1
105     return val
106 end
107
108 # Handy functions for adding/retrieving strings to/from memory.
109
110 getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
111
112 function putString(str::ASCIIString, addr::Int64)
113     mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
114 end
115
116 # Primitive creation and calling functions
117
118 function defPrim(f::Function; name="nameless")
119     push!(primitives, f)
120     push!(primNames, replace(name, "\004", "EOF"))
121
122     return -length(primitives)
123 end
124
125 function callPrim(addr::Int64)
126     if addr >=0 || -addr>length(primitives)
127         error("Attempted to execute non-existent primitive at address $addr.")
128     else
129         primitives[-addr]()
130     end
131 end
132 getPrimName(addr::Int64) = primNames[-addr]
133
134 # Word creation functions
135
136 F_IMMED = 128
137 F_HIDDEN = 256
138 F_LENMASK = 127
139
140 function createHeader(name::AbstractString, flags::Int64)
141     mem[mem[HERE]] = mem[LATEST]
142     mem[LATEST] = mem[HERE]
143     mem[HERE] += 1
144
145     mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1
146     putString(name, mem[HERE]); mem[HERE] += length(name)
147 end
148
149 function defPrimWord(name::AbstractString, f::Function; flags::Int64=0)
150     createHeader(name, flags)
151
152     codeWordAddr = mem[HERE]
153     mem[codeWordAddr] = defPrim(f, name=name)
154     mem[HERE] += 1
155
156     return codeWordAddr
157 end
158
159 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
160     createHeader(name, flags)
161
162     addr = mem[HERE]
163     mem[mem[HERE]] = DOCOL
164     mem[HERE] += 1
165
166     for wordAddr in wordAddrs
167         mem[mem[HERE]] = wordAddr
168         mem[HERE] += 1
169     end
170
171     return addr
172 end
173
174 # Variable creation functions
175
176 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
177
178     defPrimWord(name, eval(:(() -> begin
179         pushPS($(varAddr))
180         return NEXT
181     end)))
182 end
183
184 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
185     createHeader(name, flags)
186     
187     codeWordAddr = mem[HERE]
188     varAddr = mem[HERE] + 1
189
190     mem[mem[HERE]] = DOVAR; mem[HERE] += 1
191     mem[mem[HERE]] = initial; mem[HERE] += 1
192
193     return varAddr, codeWordAddr
194 end
195
196 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
197     createHeader(name, flags)
198
199     codeWordAddr = mem[HERE]
200
201     mem[mem[HERE]] = DOCON; mem[HERE] += 1
202     mem[mem[HERE]] = val; mem[HERE] += 1
203
204     return codeWordAddr
205 end
206
207 # Threading Primitives (inner interpreter)
208
209 NEXT = defPrim(() -> begin
210     reg.W = mem[reg.IP]
211     reg.IP += 1
212     return mem[reg.W]
213 end, name="NEXT")
214
215 DOCOL = defPrim(() -> begin
216     pushRS(reg.IP)
217     reg.IP = reg.W + 1
218     return NEXT
219 end, name="DOCOL")
220
221 DOVAR = defPrim(() -> begin
222     pushPS(reg.W + 1)
223     return NEXT
224 end, name="DOVAR")
225
226 DOCON = defPrim(() -> begin
227     pushPS(mem[reg.W + 1])
228     return NEXT
229 end, name="DOVAR")
230
231 EXIT = defPrimWord("EXIT", () -> begin
232     reg.IP = popRS()
233     return NEXT
234 end)
235
236 # Dictionary entries for core built-in variables, constants
237
238 HERE_CFA = defExistingVar("HERE", HERE)
239 LATEST_CFA = defExistingVar("LATEST", LATEST)
240 PSP0_CFA = defExistingVar("PSP0", PSP0)
241 RSP0_CFA = defExistingVar("RSP0", RSP0)
242
243 defConst("DOCOL", DOCOL)
244 defConst("DOCON", DOCON)
245 defConst("DOVAR", DOVAR)
246
247 defConst("DICT", DICT)
248 defConst("MEMSIZE", size_mem)
249
250 F_IMMED_CFA = defConst("F_IMMED", F_IMMED)
251 F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN)
252 F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK)
253
254 # Basic forth primitives
255
256 DROP = defPrimWord("DROP", () -> begin
257     popPS()
258     return NEXT
259 end)
260
261 SWAP = defPrimWord("SWAP", () -> begin
262     a = popPS()
263     b = popPS()
264     pushPS(a)
265     pushPS(b)
266     return NEXT
267 end)
268
269 DUP = defPrimWord("DUP", () -> begin
270     ensurePSDepth(1)
271     pushPS(mem[reg.PSP])
272     return NEXT
273 end)
274
275 OVER = defPrimWord("OVER", () -> begin
276     ensurePSDepth(2)
277     pushPS(mem[reg.PSP-1])
278     return NEXT
279 end)
280
281 ROT = defPrimWord("ROT", () -> begin
282     a = popPS()
283     b = popPS()
284     c = popPS()
285     pushPS(b)
286     pushPS(a)
287     pushPS(c)
288     return NEXT
289 end)
290
291 NROT = defPrimWord("-ROT", () -> begin
292     a = popPS()
293     b = popPS()
294     c = popPS()
295     pushPS(a)
296     pushPS(c)
297     pushPS(b)
298     return NEXT
299 end)
300
301
302 TWODROP = defPrimWord("2DROP", () -> begin
303     popPS()
304     popPS()
305     return NEXT
306 end)
307
308 TWODUP = defPrimWord("2DUP", () -> begin
309     ensurePSDepth(2)
310     a = mem[reg.PSP-1]
311     b = mem[reg.PSP]
312     pushPS(a)
313     pushPS(b)
314     return NEXT
315 end)
316
317 TWOSWAP = defPrimWord("2SWAP", () -> begin
318     a = popPS()
319     b = popPS()
320     c = popPS()
321     d = popPS()
322     pushPS(b)
323     pushPS(a)
324     pushPS(d)
325     pushPS(c)
326     return NEXT
327 end)
328
329 TWOOVER = defPrimWord("2OVER", () -> begin
330     ensurePSDepth(4)
331     a = mem[reg.PSP-3]
332     b = mem[reg.PSP-2]
333     pushPS(a)
334     pushPS(b)
335     return NEXT
336 end)
337
338 QDUP = defPrimWord("?DUP", () -> begin
339     ensurePSDepth(1)
340     val = mem[reg.PSP]
341     if val != 0
342         pushPS(val)
343     end
344     return NEXT
345 end)
346
347 INCR = defPrimWord("1+", () -> begin
348     ensurePSDepth(1)
349     mem[reg.PSP] += 1
350     return NEXT
351 end)
352
353 DECR = defPrimWord("1-", () -> begin
354     ensurePSDepth(1)
355     mem[reg.PSP] -= 1
356     return NEXT
357 end)
358
359 INCR2 = defPrimWord("2+", () -> begin
360     ensurePSDepth(1)
361     mem[reg.PSP] += 2
362     return NEXT
363 end)
364
365 DECR2 = defPrimWord("2-", () -> begin
366     ensurePSDepth(1)
367     mem[reg.PSP] -= 2
368     return NEXT
369 end)
370
371 ADD = defPrimWord("+", () -> begin
372     b = popPS()
373     a = popPS()
374     pushPS(a+b)
375     return NEXT
376 end)
377
378 SUB = defPrimWord("-", () -> begin
379     b = popPS()
380     a = popPS()
381     pushPS(a-b)
382     return NEXT
383 end)
384
385 MUL = defPrimWord("*", () -> begin
386     b = popPS()
387     a = popPS()
388     pushPS(a*b)
389     return NEXT
390 end)
391
392 DIVMOD = defPrimWord("/MOD", () -> begin
393     b = popPS()
394     a = popPS()
395     q,r = divrem(a,b)
396     pushPS(r)
397     pushPS(q)
398     return NEXT
399 end)
400
401 TWOMUL = defPrimWord("2*", () -> begin
402     pushPS(popPS() << 1)
403     return NEXT
404 end)
405
406 TWODIV = defPrimWord("2/", () -> begin
407     pushPS(popPS() >> 1)
408     return NEXT
409 end)
410
411 EQ = defPrimWord("=", () -> begin
412     b = popPS()
413     a = popPS()
414     pushPS(a==b ? -1 : 0)
415     return NEXT
416 end)
417
418 NE = defPrimWord("<>", () -> begin
419     b = popPS()
420     a = popPS()
421     pushPS(a!=b ? -1 : 0)
422     return NEXT
423 end)
424
425 LT = defPrimWord("<", () -> begin
426     b = popPS()
427     a = popPS()
428     pushPS(a<b ? -1 : 0)
429     return NEXT
430 end)
431
432 GT = defPrimWord(">", () -> begin
433     b = popPS()
434     a = popPS()
435     pushPS(a>b ? -1 : 0)
436     return NEXT
437 end)
438
439 LE = defPrimWord("<=", () -> begin
440     b = popPS()
441     a = popPS()
442     pushPS(a<=b ? -1 : 0)
443     return NEXT
444 end)
445
446 GE = defPrimWord(">=", () -> begin
447     b = popPS()
448     a = popPS()
449     pushPS(a>=b ? -1 : 0)
450     return NEXT
451 end)
452
453 ZE = defPrimWord("0=", () -> begin
454     pushPS(popPS() == 0 ? -1 : 0)
455     return NEXT
456 end)
457
458 ZNE = defPrimWord("0<>", () -> begin
459     pushPS(popPS() != 0 ? -1 : 0)
460     return NEXT
461 end)
462
463 ZLT = defPrimWord("0<", () -> begin
464     pushPS(popPS() < 0 ? -1 : 0)
465     return NEXT
466 end)
467
468 ZGT = defPrimWord("0>", () -> begin
469     pushPS(popPS() > 0 ? -1 : 0)
470     return NEXT
471 end)
472
473 ZLE = defPrimWord("0<=", () -> begin
474     pushPS(popPS() <= 0 ? -1 : 0)
475     return NEXT
476 end)
477
478 ZGE = defPrimWord("0>=", () -> begin
479     pushPS(popPS() >= 0 ? -1 : 0)
480     return NEXT
481 end)
482
483 AND = defPrimWord("AND", () -> begin
484     b = popPS()
485     a = popPS()
486     pushPS(a & b)
487     return NEXT
488 end)
489
490 OR = defPrimWord("OR", () -> begin
491     b = popPS()
492     a = popPS()
493     pushPS(a | b)
494     return NEXT
495 end)
496
497 XOR = defPrimWord("XOR", () -> begin
498     b = popPS()
499     a = popPS()
500     pushPS(a $ b)
501     return NEXT
502 end)
503
504 INVERT = defPrimWord("INVERT", () -> begin
505     pushPS(~popPS())
506     return NEXT
507 end)
508
509 # Literals
510
511 LIT = defPrimWord("LIT", () -> begin
512     pushPS(mem[reg.IP])
513     reg.IP += 1
514     return NEXT
515 end)
516
517 # Memory primitives
518
519 STORE = defPrimWord("!", () -> begin
520     addr = popPS()
521     dat = popPS()
522     mem[addr] = dat
523     return NEXT
524 end)
525
526 FETCH = defPrimWord("@", () -> begin
527     addr = popPS()
528     pushPS(mem[addr])
529     return NEXT
530 end)
531
532 ADDSTORE = defPrimWord("+!", () -> begin
533     addr = popPS()
534     toAdd = popPS()
535     mem[addr] += toAdd
536     return NEXT
537 end)
538
539 SUBSTORE = defPrimWord("-!", () -> begin
540     addr = popPS()
541     toSub = popPS()
542     mem[addr] -= toSub
543     return NEXT
544 end)
545
546
547 # Return Stack
548
549 TOR = defPrimWord(">R", () -> begin
550     pushRS(popPS())
551     return NEXT
552 end)
553
554 FROMR = defPrimWord("R>", () -> begin
555     pushPS(popRS())
556     return NEXT
557 end)
558
559 RFETCH = defPrimWord("R@", () -> begin
560     pushPS(mem[reg.RSP])
561     return NEXT
562 end)
563
564 RSPFETCH = defPrimWord("RSP@", () -> begin
565     pushPS(reg.RSP)
566     return NEXT
567 end)
568
569 RSPSTORE = defPrimWord("RSP!", () -> begin
570     reg.RSP = popPS()
571     return NEXT
572 end)
573
574 RDROP = defPrimWord("RDROP", () -> begin
575     popRS()
576     return NEXT
577 end)
578
579 # Parameter Stack
580
581 PSPFETCH = defPrimWord("PSP@", () -> begin
582     pushPS(reg.PSP)
583     return NEXT
584 end)
585
586 PSPSTORE = defPrimWord("PSP!", () -> begin
587     reg.PSP = popPS()
588     return NEXT
589 end)
590
591 # Working Register
592
593 WFETCH = defPrimWord("W@", () -> begin
594     pushPS(reg.W)
595     return NEXT
596 end)
597
598 WSTORE = defPrimWord("W!", () -> begin
599     reg.W = popPS()
600     return NEXT
601 end)
602
603 # I/O
604
605 sources = Array{Any,1}()
606 currentSource() = sources[length(sources)]
607
608 EOF = defPrimWord("\x04", () -> begin
609     close(pop!(sources))
610     if !isempty(sources)
611         return NEXT
612     else
613         return 0
614     end
615 end)
616
617 EMIT = defPrimWord("EMIT", () -> begin
618     print(Char(popPS()))
619     return NEXT
620 end)
621
622 SPAN, SPAN_CFA = defNewVar("SPAN", 0)
623 EXPECT = defPrimWord("EXPECT", () -> begin
624     maxLen = popPS()
625     addr = popPS()
626
627     if !eof(currentSource())
628         line = chomp(readline(currentSource()))
629         mem[SPAN] = min(length(line), maxLen)
630         putString(line[1:mem[SPAN]], addr)
631     else
632         mem[SPAN] = 1
633         mem[addr] = 4 # eof
634     end
635
636     return NEXT
637 end)
638
639 BASE, BASE_CFA = defNewVar("BASE", 10)
640 NUMBER = defPrimWord("NUMBER", () -> begin
641     wordAddr = popPS()+1
642     wordLen = mem[wordAddr-1]
643
644     s = getString(wordAddr, wordLen)
645
646     pushPS(parse(Int64, s, mem[BASE]))
647
648     return NEXT
649 end)
650
651 # Dictionary searches
652
653 FIND = defPrimWord("FIND", () -> begin
654
655     countedAddr = popPS()
656     wordAddr = countedAddr + 1
657     wordLen = mem[countedAddr]
658     word = lowercase(getString(wordAddr, wordLen))
659
660     latest = LATEST
661     
662     i = 0
663     while (latest = mem[latest]) > 0
664         lenAndFlags = mem[latest+1]
665         len = lenAndFlags & F_LENMASK
666         hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
667
668         if hidden || len != wordLen
669             continue
670         end
671         
672         thisAddr = latest+2
673         thisWord = lowercase(getString(thisAddr, len))
674
675         if lowercase(thisWord) == lowercase(word)
676             break
677         end
678     end
679
680     pushPS(latest)
681
682     return NEXT
683 end)
684
685 TOCFA = defPrimWord(">CFA", () -> begin
686
687     addr = popPS()
688     lenAndFlags = mem[addr+1]
689     len = lenAndFlags & F_LENMASK
690
691     pushPS(addr + 2 + len)
692
693     return NEXT
694 end)
695
696 TOPFA = defWord(">PFA", [TOCFA, INCR, EXIT])
697
698 # Branching
699
700 BRANCH = defPrimWord("BRANCH", () -> begin
701     reg.IP += mem[reg.IP]
702     return NEXT
703 end)
704
705 ZBRANCH = defPrimWord("0BRANCH", () -> begin
706     if (popPS() == 0)
707         reg.IP += mem[reg.IP]
708     else
709         reg.IP += 1
710     end
711
712     return NEXT
713 end)
714
715 # Strings
716
717 LITSTRING = defPrimWord("LITSTRING", () -> begin
718     len = mem[reg.IP]
719     reg.IP += 1
720     pushPS(reg.IP)
721     pushPS(len)
722     reg.IP += len
723
724     return NEXT
725 end)
726
727 TYPE = defPrimWord("TYPE", () -> begin
728     len = popPS()
729     addr = popPS()
730     str = getString(addr, len)
731     print(str)
732     return NEXT
733 end)
734
735 # Outer interpreter
736
737 TRACE = defPrimWord("TRACE", () -> begin
738     println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
739     print("PS: "); printPS()
740     print("RS: "); printRS()
741     print("[paused]")
742     readline()
743
744     return NEXT
745 end)
746
747 COMMA = defPrimWord(",", () -> begin
748     mem[mem[HERE]] = popPS()
749     mem[HERE] += 1
750
751     return NEXT
752 end)
753
754 BTICK = defWord("[']",
755     [FROMR, DUP, INCR, TOR, FETCH, EXIT])
756
757 EXECUTE = defPrimWord("EXECUTE", () -> begin
758     reg.W = popPS()
759     return mem[reg.W]
760 end)
761
762 TIB_CFA = defConst("TIB", TIB)
763 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
764 TOIN, TOIN_CFA = defNewVar(">IN", 0)
765
766 QUERY = defWord("QUERY",
767     [TIB_CFA, LIT, 160, EXPECT,
768     SPAN_CFA, FETCH, NUMTIB_CFA, STORE,
769     LIT, 0, TOIN_CFA, STORE,
770     EXIT])
771
772 WORD = defPrimWord("WORD", () -> begin
773     delim = popPS()
774
775     # Chew up initial occurrences of delim
776     while (mem[TOIN]<mem[NUMTIB] && mem[TIB+mem[TOIN]] == delim)
777         mem[TOIN] += 1
778     end
779
780     countAddr = mem[HERE]
781     addr = mem[HERE]+1
782
783     # Start reading in word
784     count = 0
785     while (mem[TOIN]<mem[NUMTIB])
786         mem[addr] = mem[TIB+mem[TOIN]]
787         mem[TOIN] += 1
788
789         if (mem[addr] == delim)
790             break
791         end
792
793         count += 1
794         addr += 1
795     end
796
797     # Record count
798     mem[countAddr] = count
799     pushPS(countAddr)
800
801     return NEXT
802 end)
803
804 PARSE = defPrimWord("PARSE", () -> begin
805     delim = popPS()
806
807     # Chew up initial occurrences of delim
808     addr = mem[HERE]
809
810     # Start reading input stream
811     count = 0
812     while (mem[TOIN]<mem[NUMTIB])
813         mem[addr] = mem[TIB+mem[TOIN]]
814         mem[TOIN] += 1
815
816         if (mem[addr] == delim)
817             break
818         end
819
820         count += 1
821         addr += 1
822     end
823
824     pushPS(addr)
825     pushPS(count)
826
827     return NEXT
828 end)
829
830 BYE = defPrimWord("BYE", () -> begin
831     println("Bye!")
832     return 0
833 end)
834
835 STATE, STATE_CFA = defNewVar("STATE", 0)
836
837 INTERPRET = defWord("INTERPRET",
838     [LIT, 32, WORD, # Read next space-delimited word
839
840     DUP, FETCH, ZE, ZBRANCH, 3,
841         DROP, EXIT, # Exit if TIB is exhausted
842
843     STATE_CFA, FETCH, ZBRANCH, 31,
844         # Compiling
845         DUP, FIND, QDUP, ZBRANCH, 19,
846
847             # Found word. 
848             SWAP, DROP,
849             DUP, TOCFA, SWAP, INCR, FETCH, LIT, F_IMMED, AND, ZBRANCH, 4,
850                 # Immediate: Execute!
851                 EXECUTE, BRANCH, -33,
852
853                 # Not immediate: Compile!
854                 COMMA, BRANCH, -36,
855
856             # No word found, parse number
857             NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -43,
858         
859        # Interpreting
860         DUP, FIND, QDUP, ZBRANCH, 7,
861
862             # Found word. Execute!
863             SWAP, DROP, TOCFA, EXECUTE, BRANCH, -54,
864
865             # No word found, parse number and leave on stack
866             NUMBER, BRANCH, -57,
867     EXIT]
868 )
869
870 PROMPT = defPrimWord("PROMPT", () -> begin
871     if (mem[STATE] == 0 && currentSource() == STDIN)
872         println(" ok")
873     end
874
875     return NEXT
876 end)
877
878 QUIT = defWord("QUIT",
879     [LIT, 0, STATE_CFA, STORE,
880     LIT, 0, NUMTIB_CFA, STORE,
881     RSP0_CFA, FETCH, RSPSTORE,
882     QUERY,
883     INTERPRET, PROMPT,
884     BRANCH,-4])
885
886 ABORT = defWord("ABORT",
887     [PSP0_CFA, FETCH, PSPSTORE, QUIT])
888
889 INCLUDE = defPrimWord("INCLUDE", () -> begin
890     pushPS(32)
891     callPrim(mem[WORD])
892     wordAddr = popPS()+1
893     wordLen = mem[wordAddr-1]
894     word = getString(wordAddr, wordLen)
895
896     push!(sources, open(word, "r"))
897
898     # Clear input buffer
899     mem[NUMTIB] = 0
900
901     return NEXT
902 end)
903
904 # Compilation
905
906 HEADER = defPrimWord("HEADER", () -> begin
907     wordAddr = popPS()+1
908     wordLen = mem[wordAddr-1]
909     word = getString(wordAddr, wordLen)
910
911     createHeader(word, 0)
912
913     return NEXT
914 end)
915
916 LBRAC = defPrimWord("[", () -> begin
917     mem[STATE] = 0
918     return NEXT
919 end, flags=F_IMMED)
920
921 RBRAC = defPrimWord("]", () -> begin
922     mem[STATE] = 1
923     return NEXT
924 end, flags=F_IMMED)
925
926 HIDDEN = defPrimWord("HIDDEN", () -> begin
927     addr = popPS() + 1
928     mem[addr] = mem[addr] $ F_HIDDEN
929     return NEXT
930 end)
931
932 HIDE = defWord("HIDE",
933     [LIT, 32, WORD,
934     FIND,
935     HIDDEN,
936     EXIT])
937
938 COLON = defWord(":",
939     [LIT, 32, WORD,
940     HEADER,
941     LIT, DOCOL, COMMA,
942     LATEST_CFA, FETCH, HIDDEN,
943     RBRAC,
944     EXIT])
945
946 SEMICOLON = defWord(";",
947     [LIT, EXIT, COMMA,
948     LATEST_CFA, FETCH, HIDDEN,
949     LBRAC,
950     EXIT], flags=F_IMMED)
951
952 IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin
953     lenAndFlagsAddr = mem[LATEST] + 1
954     mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
955     return NEXT
956 end, flags=F_IMMED)
957
958
959 #### VM loop ####
960
961 initialized = false
962 initFileName = nothing
963 if isfile("lib.4th")
964     initFileName = "lib.4th"
965 elseif isfile(Pkg.dir("forth/src/lib.4th"))
966     initFileName = Pkg.dir("forth/src/lib.4th")
967 end
968
969 function run(;initialize=true)
970     # Begin with STDIN as source
971     push!(sources, STDIN)
972
973     global initialized, initFileName
974     if !initialized && initialize
975         if initFileName != nothing
976             print("Including definitions from $initFileName...")
977             push!(sources, open(initFileName, "r"))
978             initialized = true
979         else
980             println("No library file found. Only primitive words available.")
981         end
982     end
983
984     # Start with IP pointing to first instruction of outer interpreter
985     reg.IP = QUIT + 1
986
987     # Primitive processing loop.
988     # Everyting else is simply a consequence of this loop!
989     jmp = NEXT
990     while jmp != 0
991         try
992             #println("Entering prim $(getPrimName(jmp))")
993             jmp = callPrim(jmp)
994
995         catch ex
996             showerror(STDOUT, ex)
997             println()
998
999             while !isempty(sources) && currentSource() != STDIN
1000                 close(pop!(sources))
1001             end
1002
1003             # QUIT
1004             reg.IP = ABORT + 1
1005             jmp = NEXT
1006         end
1007     end
1008 end
1009
1010 # Debugging tools
1011
1012 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
1013     chars = Array{Char,1}(cellsPerLine)
1014
1015     lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
1016     endAddr = startAddr + count - 1
1017
1018     q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
1019     numLines = q + (r > 0 ? 1 : 0)
1020
1021     i = lineStartAddr
1022     for l in 1:numLines
1023         print(i,":")
1024
1025         for c in 1:cellsPerLine
1026             if i >= startAddr && i <= endAddr
1027                 print("\t",mem[i])
1028                 if mem[i]>=32 && mem[i]<128
1029                     chars[c] = Char(mem[i])
1030                 else
1031                     chars[c] = '.'
1032                 end
1033             else
1034                 print("\t")
1035                 chars[c] = ' '
1036             end
1037
1038             i += 1
1039         end
1040
1041         println("\t", ASCIIString(chars))
1042     end
1043 end
1044
1045 function printPS()
1046     count = reg.PSP - mem[PSP0]
1047
1048     if count > 0
1049         print("<$count>")
1050         for i in (mem[PSP0]+1):reg.PSP
1051             print(" $(mem[i])")
1052         end
1053         println()
1054     else
1055         println("Parameter stack empty")
1056     end
1057 end
1058
1059 function printRS()
1060     count = reg.RSP - mem[RSP0]
1061
1062     if count > 0
1063         print("<$count>")
1064         for i in (mem[RSP0]+1):reg.RSP
1065             print(" $(mem[i])")
1066         end
1067         println()
1068     else
1069         println("Return stack empty")
1070     end
1071 end
1072
1073 DUMP = defPrimWord("DUMP", () -> begin
1074     count = popPS()
1075     addr = popPS()
1076
1077     dump(addr, count=count)
1078
1079     return NEXT
1080 end)
1081
1082 end