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 RFETCH = defPrimWord("R@", () -> begin
 521     pushPS(mem[reg.RSP])
 522     return NEXT
 523 end)
 524
 525 RSPFETCH = defPrimWord("RSP@", () -> begin
 526     pushPS(reg.RSP)
 527     return NEXT
 528 end)
 529
 530 RSPSTORE = defPrimWord("RSP!", () -> begin
 531     RSP = popPS()
 532     return NEXT
 533 end)
 534
 535 RDROP = defPrimWord("RDROP", () -> begin
 536     popRS()
 537     return NEXT
 538 end)
 539
 540 # Parameter Stack
 541
 542 PSPFETCH = defPrimWord("PSP@", () -> begin
 543     pushPS(reg.PSP)
 544     return NEXT
 545 end)
 546
 547 PSPSTORE = defPrimWord("PSP!", () -> begin
 548     PSP = popPS()
 549     return NEXT
 550 end)
 551
 552 # Working Register
 553
 554 WFETCH = defPrimWord("W@", () -> begin
 555     pushPS(reg.W)
 556     return NEXT
 557 end)
 558
 559 WSTORE = defPrimWord("W!", () -> begin
 560     reg.W = popPS()
 561     return NEXT
 562 end)
 563
 564 # I/O
 565
 566 sources = Array{Any,1}()
 567 currentSource() = sources[length(sources)]
 568
 569 defConst("TIB", TIB)
 570 NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0)
 571 TOIN, TOIN_CFA = defNewVar(">IN", 0)
 572 EOF = defConst("EOF", 4)
 573
 574 KEY = defPrimWord("KEY", () -> begin
 575     if mem[TOIN] >= mem[NUMTIB]
 576         mem[TOIN] = 0
 577
 578         if !eof(currentSource())
 579             line = readline(currentSource())
 580             mem[NUMTIB] = length(line)
 581             putString(line, TIB)
 582         else
 583             mem[NUMTIB] = 1
 584             mem[TIB] = EOF
 585         end
 586     end
 587
 588     pushPS(mem[TIB + mem[TOIN]])
 589     mem[TOIN] += 1
 590
 591     return NEXT
 592 end)
 593
 594 EMIT = defPrimWord("EMIT", () -> begin
 595     print(Char(popPS()))
 596     return NEXT
 597 end)
 598
 599 WORD = defPrimWord("WORD", () -> begin
 600
 601     eof_char = Char(EOF)
 602     c = eof_char
 603
 604     skip_to_end = false
 605     while true
 606
 607         callPrim(mem[KEY])
 608         c = Char(popPS())
 609
 610         if c == '\\'
 611             skip_to_end = true
 612             continue
 613         end
 614
 615         if skip_to_end
 616             if c == '\n' || c == eof_char
 617                 skip_to_end = false
 618             end
 619             continue
 620         end
 621
 622         if c == ' ' || c == '\t'
 623             continue
 624         end
 625
 626         break
 627     end
 628
 629     wordAddr = mem[HERE]
 630     offset = 0
 631
 632     if c == '\n' || c == eof_char
 633         # Treat newline as a special word
 634
 635         mem[wordAddr + offset] = Int64(c)
 636         pushPS(wordAddr)
 637         pushPS(1)
 638         return NEXT
 639     end
 640
 641     while true
 642         mem[wordAddr + offset] = Int64(c)
 643         offset += 1
 644
 645         callPrim(mem[KEY])
 646         c = Char(popPS())
 647
 648         if c == ' ' || c == '\t' || c == '\n' || c == eof_char
 649             # Rewind KEY
 650             mem[TOIN] -= 1
 651             break
 652         end
 653     end
 654
 655     wordLen = offset
 656
 657     pushPS(wordAddr)
 658     pushPS(wordLen)
 659
 660     return NEXT
 661 end)
 662
 663 NUMBER = defPrimWord("NUMBER", () -> begin
 664
 665     wordLen = popPS()
 666     wordAddr = popPS()
 667
 668     s = getString(wordAddr, wordLen)
 669
 670     try
 671         pushPS(parse(Int64, s, mem[BASE]))
 672         pushPS(0)
 673     catch
 674         pushPS(1) # Error indication
 675     end
 676
 677     return NEXT
 678 end)
 679
 680 # Dictionary searches
 681
 682 FIND = defPrimWord("FIND", () -> begin
 683
 684     wordLen = popPS()
 685     wordAddr = popPS()
 686     word = lowercase(getString(wordAddr, wordLen))
 687
 688     latest = LATEST
 689
 690     i = 0
 691     while (latest = mem[latest]) > 0
 692         lenAndFlags = mem[latest+1]
 693         len = lenAndFlags & F_LENMASK
 694         hidden = (lenAndFlags & F_HIDDEN) == F_HIDDEN
 695
 696         if hidden || len != wordLen
 697             continue
 698         end
 699
 700         thisAddr = latest+2
 701         thisWord = lowercase(getString(thisAddr, len))
 702
 703         if lowercase(thisWord) == lowercase(word)
 704             break
 705         end
 706     end
 707
 708     pushPS(latest)
 709
 710     return NEXT
 711 end)
 712
 713 TOCFA = defPrimWord(">CFA", () -> begin
 714
 715     addr = popPS()
 716     lenAndFlags = mem[addr+1]
 717     len = lenAndFlags & F_LENMASK
 718
 719     pushPS(addr + 2 + len)
 720
 721     return NEXT
 722 end)
 723
 724 TODFA = defWord(">DFA", [TOCFA, INCR, EXIT])
 725
 726 # Branching
 727
 728 BRANCH = defPrimWord("BRANCH", () -> begin
 729     reg.IP += mem[reg.IP]
 730     return NEXT
 731 end)
 732
 733 ZBRANCH = defPrimWord("0BRANCH", () -> begin
 734     if (popPS() == 0)
 735         reg.IP += mem[reg.IP]
 736     else
 737         reg.IP += 1
 738     end
 739
 740     return NEXT
 741 end)
 742
 743 # Compilation
 744
 745 CREATE = defPrimWord("CREATE", () -> begin
 746
 747     wordLen = popPS()
 748     wordAddr = popPS()
 749     word = getString(wordAddr, wordLen)
 750
 751     createHeader(word, 0)
 752
 753     return NEXT
 754 end)
 755
 756 COMMA = defPrimWord(",", () -> begin
 757     mem[mem[HERE]] = popPS()
 758     mem[HERE] += 1
 759
 760     return NEXT
 761 end)
 762
 763 LBRAC = defPrimWord("[", () -> begin
 764     mem[STATE] = 0
 765     return NEXT
 766 end, flags=F_IMMED)
 767
 768 RBRAC = defPrimWord("]", () -> begin
 769     mem[STATE] = 1
 770     return NEXT
 771 end, flags=F_IMMED)
 772
 773 HIDDEN = defPrimWord("HIDDEN", () -> begin
 774     addr = popPS() + 1
 775     mem[addr] = mem[addr] $ F_HIDDEN
 776     return NEXT
 777 end)
 778
 779 HIDE = defWord("HIDE",
 780     [WORD,
 781     FIND,
 782     HIDDEN,
 783     EXIT])
 784
 785 COLON = defWord(":",
 786     [WORD,
 787     CREATE,
 788     LIT, DOCOL, COMMA,
 789     LATEST_CFA, FETCH, HIDDEN,
 790     RBRAC,
 791     EXIT])
 792
 793 SEMICOLON = defWord(";",
 794     [LIT, EXIT, COMMA,
 795     LATEST_CFA, FETCH, HIDDEN,
 796     LBRAC,
 797     EXIT], flags=F_IMMED)
 798
 799 IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin
 800     lenAndFlagsAddr = mem[LATEST] + 1
 801     mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_IMMED
 802     return NEXT
 803 end, flags=F_IMMED)
 804
 805 TICK = defWord("'",
 806     [STATE_CFA, FETCH, ZBRANCH, 7,
 807     FROMR, DUP, INCR, TOR, FETCH, EXIT,
 808     WORD, FIND, TOCFA, EXIT])
 809
 810 # Strings
 811
 812 LITSTRING = defPrimWord("LITSTRING", () -> begin
 813     len = mem[reg.IP]
 814     reg.IP += 1
 815     pushPS(reg.IP)
 816     pushPS(len)
 817     reg.IP += len
 818
 819     return NEXT
 820 end)
 821
 822 TELL = defPrimWord("TELL", () -> begin
 823     len = popPS()
 824     addr = popPS()
 825     str = getString(addr, len)
 826     print(str)
 827     return NEXT
 828 end)
 829
 830 # Outer interpreter
 831
 832 EXECUTE = defPrimWord("EXECUTE", () -> begin
 833     reg.W = popPS()
 834     return mem[reg.W]
 835 end)
 836
 837 INTERPRET = defPrimWord("INTERPRET", () -> begin
 838
 839     callPrim(mem[WORD])
 840
 841     wordName = getString(mem[reg.PSP-1], mem[reg.PSP])
 842     #println("... ", replace(replace(wordName, "\004", "EOF"), "\n", "\\n"), " ...")
 843
 844     callPrim(mem[TWODUP])
 845     callPrim(mem[FIND])
 846
 847     wordAddr = mem[reg.PSP]
 848
 849     if wordAddr>0
 850         # Word in dictionary
 851
 852         isImmediate = (mem[wordAddr+1] & F_IMMED) != 0
 853         callPrim(mem[TOCFA])
 854
 855         callPrim(mem[ROT]) # get rid of extra copy of word string details
 856         popPS()
 857         popPS()
 858
 859         if mem[STATE] == 0 || isImmediate
 860             # Execute!
 861             return callPrim(mem[EXECUTE])
 862         else
 863             # Append CFA to dictionary
 864             callPrim(mem[COMMA])
 865         end
 866     else
 867         # Not in dictionary, assume number
 868
 869         popPS()
 870
 871         callPrim(mem[NUMBER])
 872
 873         if popPS() != 0
 874             println("Parse error at word: '$wordName'")
 875             return NEXT
 876         end
 877
 878         if mem[STATE] == 0
 879             # Number already on stack!
 880         else
 881             # Append literal to dictionary
 882             pushPS(LIT)
 883             callPrim(mem[COMMA])
 884             callPrim(mem[COMMA])
 885         end
 886     end
 887
 888     return NEXT
 889 end)
 890
 891 QUIT = defWord("QUIT",
 892     [RSP0_CFA, RSPSTORE,
 893     INTERPRET,
 894     BRANCH,-2])
 895
 896 BYE = defPrimWord("BYE", () -> begin
 897     return 0
 898 end)
 899
 900 PROMPT = defPrimWord("PROMPT", () -> begin
 901     println(" ok")
 902 end)
 903
 904 NL = defPrimWord("\n", () -> begin
 905     if mem[STATE] == 0 && currentSource() == STDIN
 906         callPrim(mem[PROMPT])
 907     end
 908     return NEXT
 909 end, flags=F_IMMED)
 910
 911 INCLUDE = defPrimWord("INCLUDE", () -> begin
 912     callPrim(mem[WORD])
 913     wordLen = popPS()
 914     wordAddr = popPS()
 915     word = getString(wordAddr, wordLen)
 916
 917     push!(sources, open(word, "r"))
 918
 919     # Clear input buffer
 920     mem[NUMTIB] = 0
 921
 922     return NEXT
 923 end)
 924
 925 EOF_WORD = defPrimWord("\x04", () -> begin
 926     if currentSource() != STDIN
 927         close(currentSource())
 928     end
 929
 930     pop!(sources)
 931
 932     if length(sources)>0
 933         if currentSource() == STDIN
 934             callPrim(mem[PROMPT])
 935         end
 936
 937         return NEXT
 938     else
 939         return 0
 940     end
 941 end, flags=F_IMMED)
 942
 943 # Odds and Ends
 944
 945 CHAR = defPrimWord("CHAR", () -> begin
 946     callPrim(mem[WORD])
 947     wordLen = popPS()
 948     wordAddr = popPS()
 949     word = getString(wordAddr, wordLen)
 950     pushPS(Int64(word[1]))
 951
 952     return NEXT
 953 end)
 954
 955 #### VM loop ####
 956 function run()
 957     # Begin with STDIN as source
 958     push!(sources, STDIN)
 959
 960     # Start with IP pointing to first instruction of outer interpreter
 961     reg.IP = QUIT + 1
 962
 963     # Primitive processing loop.
 964     # Everyting else is simply a consequence of this loop!
 965     jmp = NEXT
 966     while jmp != 0
 967         try
 968             #println("Evaluating prim ", jmp," ", primNames[-jmp])
 969             jmp = callPrim(jmp)
 970
 971         catch ex
 972             showerror(STDOUT, ex)
 973             println()
 974
 975             mem[NUMTIB] = 0
 976             reg.IP = QUIT + 1
 977             jmp = NEXT
 978         end
 979     end
 980 end
 981
 982 # Debugging tools
 983
 984 function dump(startAddr::Int64; count::Int64 = 100, cellsPerLine::Int64 = 10)
 985     chars = Array{Char,1}(cellsPerLine)
 986
 987     lineStartAddr = cellsPerLine*div((startAddr-1),cellsPerLine) + 1
 988     endAddr = startAddr + count - 1
 989
 990     q, r = divrem((endAddr-lineStartAddr+1), cellsPerLine)
 991     numLines = q + (r > 0 ? 1 : 0)
 992
 993     i = lineStartAddr
 994     for l in 1:numLines
 995         print(i,":")
 996
 997         for c in 1:cellsPerLine
 998             if i >= startAddr && i <= endAddr
 999                 print("\t",mem[i])
1000                 if mem[i]>=32 && mem[i]<128
1001                     chars[c] = Char(mem[i])
1002                 else
1003                     chars[c] = '.'
1004                 end
1005             else
1006                 print("\t")
1007                 chars[c] = ' '
1008             end
1009
1010             i += 1
1011         end
1012
1013         println("\t", ASCIIString(chars))
1014     end
1015 end
1016
1017 function printPS()
1018     count = reg.PSP - mem[PSP0]
1019
1020     if count > 0
1021         print("<$count>")
1022         for i in (mem[PSP0]+1):reg.PSP
1023             print(" $(mem[i])")
1024         end
1025         println()
1026     else
1027         println("Parameter stack empty")
1028     end
1029 end
1030
1031 function printRS()
1032     count = reg.RSP - mem[RSP0]
1033
1034     if count > 0
1035         print("<$count>")
1036         for i in (mem[RSP0]+1):reg.RSP
1037             print(" $(mem[i])")
1038         end
1039         println()
1040     else
1041         println("Return stack empty")
1042     end
1043 end
1044
1045 DUMP = defPrimWord("DUMP", () -> begin
1046     count = popPS()
1047     addr = popPS()
1048
1049     dump(addr, count=count)
1050
1051     return NEXT
1052 end)
1053
1054 end