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