src/forth.jl

   1 module forth
   2
   3 # VM mem size
   4 size_mem = 640*1024
   5
   6 # Buffer sizes
   7 size_RS = 1024   # Return stack size
   8 size_PS = 1024   # Parameter stack size
   9 size_TIB = 1096  # 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 the negative index
  30 # into the primitives array which contains only 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     X::Int64    # Extra register
  59 end
  60 reg = Reg(mem[RSP0], mem[PSP0], 0, 0, 0)
  61
  62 # Stack manipulation
  63
  64 type StackUnderflow <: Exception end
  65
  66 getRSDepth() = reg.RSP - mem[RSP0]
  67 getPSDepth() = reg.PSP - mem[PSP0]
  68
  69 function ensurePSDepth(depth::Int64)
  70     if getPSDepth()<depth
  71         throw(StackUnderflow())
  72     end
  73 end
  74
  75 function ensureRSDepth(depth::Int64)
  76     if getRSDepth()<depth
  77         throw(StackUnderflow())
  78     end
  79 end
  80
  81 function pushRS(val::Int64)
  82     mem[reg.RSP+=1] = val
  83 end
  84
  85 function popRS()
  86     ensureRSDepth(1)
  87
  88     val = mem[reg.RSP]
  89     reg.RSP -= 1
  90     return val
  91 end
  92
  93 function pushPS(val::Int64)
  94     mem[reg.PSP += 1] = val
  95 end
  96
  97 function popPS()
  98     ensurePSDepth(1)
  99
 100     val = mem[reg.PSP]
 101     reg.PSP -= 1
 102     return val
 103 end
 104
 105 # Handy functions for adding/retrieving strings to/from memory.
 106
 107 getString(addr::Int64, len::Int64) = ASCIIString([Char(c) for c in mem[addr:(addr+len-1)]])
 108 function putString(str::ASCIIString, addr::Int64)
 109     mem[addr:(addr+length(str)-1)] = [Int64(c) for c in str]
 110 end
 111
 112 # Primitive creation and calling functions
 113
 114 function createHeader(name::AbstractString, flags::Int64)
 115     mem[mem[HERE]] = mem[LATEST]
 116     mem[LATEST] = mem[HERE]
 117     mem[HERE] += 1
 118
 119     mem[mem[HERE]] = length(name) | flags; mem[HERE] += 1
 120     putString(name, mem[HERE]); mem[HERE] += length(name)
 121 end
 122
 123 function defPrim(name::AbstractString, f::Function; flags::Int64=0)
 124     createHeader(name, flags)
 125
 126     codeWordAddr = mem[HERE]
 127     push!(primitives, f)
 128     mem[codeWordAddr] = -length(primitives)
 129     mem[HERE] += 1
 130
 131     push!(primNames, name)
 132
 133     return codeWordAddr
 134 end
 135
 136 callPrim(addr::Int64) = primitives[-addr]()
 137
 138 function defExistingVar(name::AbstractString, varAddr::Int64; flags::Int64=0)
 139     defPrim(name, eval(:(() -> begin
 140         pushPS($(varAddr))
 141         return mem[NEXT]
 142     end)))
 143 end
 144
 145 function defNewVar(name::AbstractString, initial::Int64; flags::Int64=0)
 146     createHeader(name, flags)
 147
 148     codeWordAddr = mem[HERE]
 149     varAddr = mem[HERE] + 1
 150     push!(primitives, eval(:(() -> begin
 151         pushPS($(varAddr))
 152         return mem[NEXT]
 153     end)))
 154     mem[mem[HERE]] = -length(primitives); mem[HERE] += 1
 155
 156     mem[mem[HERE]] = initial; mem[HERE] += 1
 157
 158     return varAddr, codeWordAddr
 159 end
 160
 161 function defConst(name::AbstractString, val::Int64; flags::Int64=0)
 162     defPrim(name, eval(:(() -> begin
 163         pushPS($(val))
 164         return mem[NEXT]
 165     end)))
 166
 167     return val
 168 end
 169
 170 function defWord(name::AbstractString, wordAddrs::Array{Int64,1}; flags::Int64=0)
 171     createHeader(name, flags)
 172
 173     addr = mem[HERE]
 174     mem[mem[HERE]] = mem[DOCOL]
 175     mem[HERE] += 1
 176
 177     for wordAddr in wordAddrs
 178         mem[mem[HERE]] = wordAddr
 179         mem[HERE] += 1
 180     end
 181
 182     return addr
 183 end
 184
 185 # Threading Primitives (inner interpreter)
 186
 187 NEXT = defPrim("NEXT", () -> begin
 188     reg.W = mem[reg.IP]
 189     reg.IP += 1
 190     return mem[reg.W]
 191 end)
 192
 193 DOCOL = defPrim("DOCOL", () -> begin
 194     pushRS(reg.IP)
 195     reg.IP = reg.W + 1
 196     return mem[NEXT]
 197 end)
 198
 199 EXIT = defPrim("EXIT", () -> begin
 200     reg.IP = popRS()
 201     return mem[NEXT]
 202 end)
 203
 204 # Basic forth primitives
 205
 206 DROP = defPrim("DROP", () -> begin
 207     popPS()
 208     return mem[NEXT]
 209 end)
 210
 211 SWAP = defPrim("SWAP", () -> begin
 212     a = popPS()
 213     b = popPS()
 214     pushPS(a)
 215     pushPS(b)
 216     return mem[NEXT]
 217 end)
 218
 219 DUP = defPrim("DUP", () -> begin
 220     pushPS(mem[reg.PSP])
 221     return mem[NEXT]
 222 end)
 223
 224 OVER = defPrim("OVER", () -> begin
 225     ensurePSDepth(2)
 226     pushPS(mem[reg.PSP-1])
 227     return mem[NEXT]
 228 end)
 229
 230 ROT = defPrim("ROT", () -> begin
 231     a = popPS()
 232     b = popPS()
 233     c = popPS()
 234     pushPS(a)
 235     pushPS(c)
 236     pushPS(b)
 237     return mem[NEXT]
 238 end)
 239
 240 NROT = defPrim("-ROT", () -> begin
 241     a = popPS()
 242     b = popPS()
 243     c = popPS()
 244     pushPS(b)
 245     pushPS(a)
 246     pushPS(c)
 247     return mem[NEXT]
 248 end)
 249
 250 TWODROP = defPrim("2DROP", () -> begin
 251     popPS()
 252     popPS()
 253     return mem[NEXT]
 254 end)
 255
 256 TWODUP = defPrim("2DUP", () -> begin
 257     ensurePSDepth(2)
 258     a = mem[reg.PSP-1]
 259     b = mem[reg.PSP]
 260     pushPS(a)
 261     pushPS(b)
 262     return mem[NEXT]
 263 end)
 264
 265 TWOSWAP = defPrim("2SWAP", () -> begin
 266     a = popPS()
 267     b = popPS()
 268     c = popPS()
 269     d = popPS()
 270     pushPS(b)
 271     pushPS(a)
 272     pushPS(c)
 273     pushPS(d)
 274     return mem[NEXT]
 275 end)
 276
 277 QDUP = defPrim("?DUP", () -> begin
 278     ensurePSDepth(1)
 279     val = mem[reg.PSP]
 280     if val != 0
 281         pushPS(val)
 282     end
 283     return mem[NEXT]
 284 end)
 285
 286 INCR = defPrim("1+", () -> begin
 287     ensurePSDepth(1)
 288     mem[reg.PSP] += 1
 289     return mem[NEXT]
 290 end)
 291
 292 DECR = defPrim("1-", () -> begin
 293     ensurePSDepth(1)
 294     mem[reg.PSP] -= 1
 295     return mem[NEXT]
 296 end)
 297
 298 INCR2 = defPrim("2+", () -> begin
 299     ensurePSDepth(1)
 300     mem[reg.PSP] += 2
 301     return mem[NEXT]
 302 end)
 303
 304 DECR2 = defPrim("2-", () -> begin
 305     ensurePSDepth(1)
 306     mem[reg.PSP] -= 2
 307     return mem[NEXT]
 308 end)
 309
 310 ADD = defPrim("+", () -> begin
 311     b = popPS()
 312     a = popPS()
 313     pushPS(a+b)
 314     return mem[NEXT]
 315 end)
 316
 317 SUB = defPrim("-", () -> begin
 318     b = popPS()
 319     a = popPS()
 320     pushPS(a-b)
 321     return mem[NEXT]
 322 end)
 323
 324 MUL = defPrim("*", () -> begin
 325     b = popPS()
 326     a = popPS()
 327     pushPS(a*b)
 328     return mem[NEXT]
 329 end)
 330
 331 DIVMOD = defPrim("/MOD", () -> begin
 332     b = popPS()
 333     a = popPS()
 334     q,r = divrem(a,b)
 335     pushPS(r)
 336     pushPS(q)
 337     return mem[NEXT]
 338 end)
 339
 340 EQU = defPrim("=", () -> begin
 341     b = popPS()
 342     a = popPS()
 343     pushPS(a==b ? -1 : 0)
 344     return mem[NEXT]
 345 end)
 346
 347 NEQU = defPrim("<>", () -> begin
 348     b = popPS()
 349     a = popPS()
 350     pushPS(a!=b ? -1 : 0)
 351     return mem[NEXT]
 352 end)
 353
 354 LT = defPrim("<", () -> begin
 355     b = popPS()
 356     a = popPS()
 357     pushPS(a<b ? -1 : 0)
 358     return mem[NEXT]
 359 end)
 360
 361 GT = defPrim(">", () -> begin
 362     b = popPS()
 363     a = popPS()
 364     pushPS(a>b ? -1 : 0)
 365     return mem[NEXT]
 366 end)
 367
 368 LE = defPrim("<=", () -> begin
 369     b = popPS()
 370     a = popPS()
 371     pushPS(a<=b ? -1 : 0)
 372     return mem[NEXT]
 373 end)
 374
 375 GE = defPrim(">=", () -> begin
 376     b = popPS()
 377     a = popPS()
 378     pushPS(a>=b ? -1 : 0)
 379     return mem[NEXT]
 380 end)
 381
 382 ZEQU = defPrim("0=", () -> begin
 383     pushPS(popPS() == 0 ? -1 : 0)
 384     return mem[NEXT]
 385 end)
 386
 387 ZNEQU = defPrim("0<>", () -> begin
 388     pushPS(popPS() != 0 ? -1 : 0)
 389     return mem[NEXT]
 390 end)
 391
 392 ZLT = defPrim("0<", () -> begin
 393     pushPS(popPS() < 0 ? -1 : 0)
 394     return mem[NEXT]
 395 end)
 396
 397 ZGT = defPrim("0>", () -> begin
 398     pushPS(popPS() > 0 ? -1 : 0)
 399     return mem[NEXT]
 400 end)
 401
 402 ZLE = defPrim("0<=", () -> begin
 403     pushPS(popPS() <= 0 ? -1 : 0)
 404     return mem[NEXT]
 405 end)
 406
 407 ZGE = defPrim("0>=", () -> begin
 408     pushPS(popPS() >= 0 ? -1 : 0)
 409     return mem[NEXT]
 410 end)
 411
 412 AND = defPrim("AND", () -> begin
 413     b = popPS()
 414     a = popPS()
 415     pushPS(a & b)
 416     return mem[NEXT]
 417 end)
 418
 419 OR = defPrim("OR", () -> begin
 420     b = popPS()
 421     a = popPS()
 422     pushPS(a | b)
 423     return mem[NEXT]
 424 end)
 425
 426 XOR = defPrim("XOR", () -> begin
 427     b = popPS()
 428     a = popPS()
 429     pushPS(a $ b)
 430     return mem[NEXT]
 431 end)
 432
 433 INVERT = defPrim("INVERT", () -> begin
 434     pushPS(~popPS())
 435     return mem[NEXT]
 436 end)
 437
 438 # Literals
 439
 440 LIT = defPrim("LIT", () -> begin
 441     pushPS(mem[reg.IP])
 442     reg.IP += 1
 443     return mem[NEXT]
 444 end)
 445
 446 # Memory primitives
 447
 448 STORE = defPrim("!", () -> begin
 449     addr = popPS()
 450     dat = popPS()
 451     mem[addr] = dat
 452     return mem[NEXT]
 453 end)
 454
 455 FETCH = defPrim("@", () -> begin
 456     addr = popPS()
 457     pushPS(mem[addr])
 458     return mem[NEXT]
 459 end)
 460
 461 ADDSTORE = defPrim("+!", () -> begin
 462     addr = popPS()
 463     toAdd = popPS()
 464     mem[addr] += toAdd
 465     return mem[NEXT]
 466 end)
 467
 468 SUBSTORE = defPrim("-!", () -> begin
 469     addr = popPS()
 470     toSub = popPS()
 471     mem[addr] -= toSub
 472     return mem[NEXT]
 473 end)
 474
 475
 476 # Built-in variables
 477
 478 HERE_CFA = defExistingVar("HERE", HERE)
 479 LATEST_CFA = defExistingVar("LATEST", LATEST)
 480 PSP0_CFA = defExistingVar("PSP0", PSP0)
 481 RSP0_CFA = defExistingVar("RSP0", RSP0)
 482 STATE, STATE_CFA = defNewVar("STATE", 0)
 483 BASE, BASE_CFA = defNewVar("BASE", 10)
 484
 485 # Constants
 486
 487 defConst("VERSION", 1)
 488 defConst("DOCOL", DOCOL)
 489 defConst("DICT", DICT)
 490 F_IMMED = defConst("F_IMMED", 128)
 491 F_HIDDEN = defConst("F_HIDDEN", 256)
 492 F_LENMASK = defConst("F_LENMASK", 127)
 493
 494 # Return Stack
 495
 496 TOR = defPrim(">R", () -> begin
 497     pushRS(popPS())
 498     return mem[NEXT]
 499 end)
 500
 501 FROMR = defPrim("R>", () -> begin
 502     pushPS(popRS())
 503     return mem[NEXT]
 504 end)
 505
 506 RSPFETCH = defPrim("RSP@", () -> begin
 507     pushPS(reg.RSP)
 508     return mem[NEXT]
 509 end)
 510
 511 RSPSTORE = defPrim("RSP!", () -> begin
 512     RSP = popPS()
 513     return mem[NEXT]
 514 end)
 515
 516 RDROP = defPrim("RDROP", () -> begin
 517     popRS()
 518     return mem[NEXT]
 519 end)
 520
 521 # Parameter Stack
 522
 523 PSPFETCH = defPrim("PSP@", () -> begin
 524     pushPS(reg.PSP)
 525     return mem[NEXT]
 526 end)
 527
 528 PSPSTORE = defPrim("PSP!", () -> begin
 529     PSP = popPS()
 530     return mem[NEXT]
 531 end)
 532
 533 # I/O
 534
 535 defConst("TIB", TIB)
 536 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
 537 TOIN, TOIN_CFA = defNewVar(">IN", 0)
 538
 539 KEY = defPrim("KEY", () -> begin
 540     if mem[TOIN] >= mem[NUMTIB]
 541         mem[TOIN] = 0
 542         line = readline()
 543         mem[NUMTIB] = length(line)
 544         putString(line, TIB)
 545     end
 546
 547     pushPS(mem[TIB + mem[TOIN]])
 548     mem[TOIN] += 1
 549
 550     return mem[NEXT]
 551 end)
 552
 553 EMIT = defPrim("EMIT", () -> begin
 554     print(Char(popPS()))
 555     return mem[NEXT]
 556 end)
 557
 558 WORD = defPrim("WORD", () -> begin
 559
 560     c = -1
 561
 562     skip_to_end = false
 563     while true
 564
 565         callPrim(mem[KEY])
 566         c = Char(popPS())
 567
 568         if c == '\\'
 569             skip_to_end = true
 570             continue
 571         end
 572
 573         if skip_to_end
 574             if c == '\n'
 575                 skip_to_end = false
 576             end
 577             continue
 578         end
 579
 580         if c == ' ' || c == '\t'
 581             continue
 582         end
 583
 584         break
 585     end
 586
 587     wordAddr = mem[HERE]
 588     offset = 0
 589
 590     if c == '\n'
 591         # Treat newline as a special word
 592
 593         mem[wordAddr + offset] = Int64(c)
 594         pushPS(wordAddr)
 595         pushPS(1)
 596         return mem[NEXT]
 597     end
 598
 599     while true
 600         mem[wordAddr + offset] = Int64(c)
 601         offset += 1
 602
 603         callPrim(mem[KEY])
 604         c = Char(popPS())
 605
 606         if c == ' ' || c == '\t' || c == '\n'
 607             # Rewind KEY
 608             mem[TOIN] -= 1
 609             break
 610         end
 611     end
 612
 613     wordLen = offset
 614
 615     pushPS(wordAddr)
 616     pushPS(wordLen)
 617
 618     return mem[NEXT]
 619 end)
 620
 621 NUMBER = defPrim("NUMBER", () -> begin
 622
 623     wordLen = popPS()
 624     wordAddr = popPS()
 625
 626     s = getString(wordAddr, wordLen)
 627
 628     try
 629         pushPS(parse(Int64, s, mem[BASE]))
 630         pushPS(0)
 631     catch
 632         pushPS(1) # Error indication
 633     end
 634
 635     return mem[NEXT]
 636 end)
 637
 638 # Dictionary searches
 639
 640 FIND = defPrim("FIND", () -> begin
 641
 642     wordLen = popPS()
 643     wordAddr = popPS()
 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 mem[NEXT]
 669 end)
 670
 671 TOCFA = defPrim(">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 mem[NEXT]
 680 end)
 681
 682 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
 683
 684 # Compilation
 685
 686 CREATE = defPrim("CREATE", () -> begin
 687
 688     wordLen = popPS()
 689     wordAddr = popPS()
 690     word = getString(wordAddr, wordLen)
 691
 692     createHeader(word, 0)
 693
 694     return mem[NEXT]
 695 end)
 696
 697 COMMA = defPrim(",", () -> begin
 698     mem[mem[HERE]] = popPS()
 699     mem[HERE] += 1
 700
 701     return mem[NEXT]
 702 end)
 703
 704 LBRAC = defPrim("[", () -> begin
 705     mem[STATE] = 0
 706     return mem[NEXT]
 707 end, flags=F_IMMED)
 708
 709 RBRAC = defPrim("]", () -> begin
 710     mem[STATE] = 1
 711     return mem[NEXT]
 712 end, flags=F_IMMED)
 713
 714 HIDDEN = defPrim("HIDDEN", () -> begin
 715     addr = popPS() + 1
 716     mem[addr] = mem[addr] $ F_HIDDEN
 717     return mem[NEXT]
 718 end)
 719
 720 HIDE = defWord("HIDE",
 721     [WORD,
 722     FIND,
 723     HIDDEN,
 724     EXIT])
 725
 726 COLON = defWord(":",
 727     [WORD,
 728     CREATE,
 729     LIT, DOCOL, COMMA,
 730     LATEST, FETCH, HIDDEN,
 731     RBRAC,
 732     EXIT])
 733
 734 SEMICOLON = defWord(";",
 735     [LIT, EXIT, COMMA,
 736     LATEST, FETCH, HIDDEN,
 737     LBRAC,
 738     EXIT], flags=F_IMMED)
 739
 740 IMMEDIATE = defPrim("IMMEDIATE", () -> begin
 741     lenAndFlagsAddr = mem[LATEST] + 1
 742     mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
 743     return mem[NEXT]
 744 end, flags=F_IMMED)
 745
 746 TICK = defWord("'", [WORD, FIND, TOCFA, EXIT])
 747
 748 # Branching
 749
 750 BRANCH = defPrim("BRANCH", () -> begin
 751     reg.IP += mem[reg.IP]
 752     return mem[NEXT]
 753 end)
 754
 755 ZBRANCH = defPrim("0BRANCH", () -> begin
 756     if (popPS() == 0)
 757         reg.IP += mem[reg.IP]
 758     else
 759         reg.IP += 1
 760     end
 761
 762     return mem[NEXT]
 763 end)
 764
 765 # Strings
 766
 767 LITSTRING = defPrim("LITSTRING", () -> begin
 768     len = mem[reg.IP]
 769     reg.IP += 1
 770     pushPS(reg.IP)
 771     pushPS(len)
 772     reg.IP += len
 773
 774     return mem[NEXT]
 775 end)
 776
 777 TELL = defPrim("TELL", () -> begin
 778     len = popPS()
 779     addr = popPS()
 780     str = getString(addr, len)
 781     print(str)
 782     return mem[NEXT]
 783 end)
 784
 785 # Outer interpreter
 786
 787 INTERPRET = defPrim("INTERPRET", () -> begin
 788
 789     callPrim(mem[WORD])
 790
 791     wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
 792     println("... ", replace(wordName, "\n", "\\n"), " ...")
 793
 794     callPrim(mem[TWODUP])
 795     callPrim(mem[FIND])
 796
 797     wordAddr = mem[reg.PSP]
 798
 799
 800     if wordAddr>0
 801         # Word in dictionary
 802
 803         isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
 804         callPrim(mem[TOCFA])
 805
 806         callPrim(mem[ROT]) # get rid of extra copy of word string details
 807         popPS()
 808         popPS()
 809
 810         if mem[STATE] == 0 || isImmediate
 811             # Execute!
 812             return mem[popPS()]
 813         else
 814             # Append CFA to dictionary
 815             callPrim(mem[COMMA])
 816         end
 817     else
 818         # Not in dictionary, assume number
 819
 820         popPS()
 821
 822         callPrim(mem[NUMBER])
 823
 824         if popPS() != 0
 825             println("Parse error at word: '$wordName'")
 826             return mem[NEXT]
 827         else
 828         end
 829
 830         if mem[STATE] == 0
 831             # Number already on stack!
 832         else
 833             # Append literal to dictionary
 834             pushPS(LIT)
 835             callPrim(mem[COMMA])
 836             callPrim(mem[COMMA])
 837         end
 838     end
 839
 840     return mem[NEXT]
 841 end)
 842
 843 QUIT = defWord("QUIT",
 844     [RSP0_CFA, RSPSTORE,
 845     INTERPRET,
 846     BRANCH,-2])
 847
 848 NL = defPrim("\n", () -> begin
 849     if mem[STATE] == 0
 850         println(" ok")
 851     end
 852     return mem[NEXT]
 853 end)
 854
 855 # Odds and Ends
 856
 857 CHAR = defPrim("CHAR", () -> begin
 858     callPrim(mem[WORD])
 859     wordLen = popPS()
 860     wordAddr = popPS()
 861     word = getString(wordAddr, wordLen)
 862     pushPS(Int64(word[1]))
 863
 864     return mem[NEXT]
 865 end)
 866
 867 EXECUTE = defPrim("EXECUTE", () -> begin
 868     return mem[popPS()]
 869 end)
 870
 871 BYE = defPrim("BYE", () -> begin
 872     return 0
 873 end)
 874
 875 #### VM loop ####
 876 function runVM()
 877     # Start with IP pointing to first instruction of outer interpreter
 878     reg.IP = QUIT + 1
 879
 880     # Primitive processing loop.
 881     # Everyting else is simply a consequence of this loop!
 882     jmp = mem[NEXT]
 883     while (jmp = callPrim(jmp)) != 0
 884         println("Evaluating prim $jmp [$(primNames[-jmp])]")
 885     end
 886 end
 887
 888 # Debugging tools
 889
 890 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
 891     chars = Array{Char,1}(cellsPerLine)
 892
 893     lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
 894     endAddr = startAddr + count - 1
 895
 896     q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
 897     numLines = q + (r > 0 ? 1 : 0)
 898
 899     i = lineStartAddr
 900     for l in 1:numLines
 901         print(i,":")
 902
 903         for c in 1:cellsPerLine
 904             if i >= startAddr && i <= endAddr
 905                 print("\t",mem[i])
 906                 if mem[i]>=32 && mem[i]<128
 907                     chars[c] = Char(mem[i])
 908                 else
 909                     chars[c] = '.'
 910                 end
 911             else
 912                 print("\t")
 913                 chars[c] = ' '
 914             end
 915
 916             i += 1
 917         end
 918
 919         println("\t", ASCIIString(chars))
 920     end
 921 end
 922
 923 function printPS()
 924     count = reg.PSP - mem[PSP0]
 925
 926     if count > 0
 927         print("<$count>")
 928         for i in (mem[PSP0]+1):reg.PSP
 929             print(" $(mem[i])")
 930         end
 931         println()
 932     else
 933         println("Parameter stack empty")
 934     end
 935 end
 936
 937 function printRS()
 938     count = reg.RSP - mem[RSP0]
 939
 940     if count > 0
 941         print("<$count>")
 942         for i in (mem[RSP0]+1):reg.RSP
 943             print(" $(mem[i])")
 944         end
 945         println()
 946     else
 947         println("Return stack empty")
 948     end
 949 end
 950
 951 end