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