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