src/forth.jl

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