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