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