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