major compliance refactor; undo packed literals for now

2 years ago · 2ece0e4993
parent d175fa6a88
commit 2ece0e4993
11 changed files with 1238 additions and 110 deletions
--- a/README.md
+++ b/README.md
@ -4,16 +4,23 @@

 Alee is a portable and concise Forth implementation in modern C++. Its primary aims are for reduced program size and execution efficiency. Portability includes bare-metal platforms, with intentions to support microcontrollers with kilobytes of memory.

-## Compatibility
+## Cross-platform compatibility

-A base dictionary is being built by working through the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). These word lists are included in `compat.txt`, with "yes" indicating that the word is implemented either in `core.fth` or within Alee itself.
+Alee relies on the C++17 standard. Alee *does not* rely on operating-system-specific functions, making portability easy. See the `msp430` target for an example of a port.

-A `sys` word is available to provide access to user-defined C++ functions.
+System-specific functionality such as text output is contained to a `sys` word. This word calls a user-supplied `user_sys` C++ function that should implement the necessary (or any additional) system-specific functionality.
+
+# Forth compatibility
+
+A base dictionary is being built by working through the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). These glossaries are listed in `compat.txt`, with "yes" indicating that the word is implemented either in `core.fth` or within Alee itself. `core.fth` may be compiled into a binary for loading on targets without filesystems.
+
+Alee Forth aims for compliance with common Forth standards like Forth 2012 and ANS Forth. Compliance is tested using a [Forth 2012 test suite](https://github.com/gerryjackson/forth2012-test-suite). Supported test files are in the `test` directory, with non-passing or unimplemented tests commented out.

 ## Building

 Alee requires `make` and a C++17-compatible compiler.

 To compile, simply run the `make` command. This will produce a library, `libalee.a`, as well as a REPL binary named `alee`.  
-A `small` target exists that optimizes the build for size.
+A `small` target exists that optimizes the build for size.  
+A `fast` target exists that optimizes for maximum performance on the host (not target) system.

--- a/alee.cpp
+++ b/alee.cpp
@ -19,6 +19,7 @@
 #include "alee.hpp"
 #include "memdict.hpp"

+#include <charconv>
 #include <fstream>
 #include <iostream>
 #include <vector>
@ -35,11 +36,7 @@ int main(int argc, char *argv[])
    State state (dict, readchar);
    Parser parser;

-    dict.write(Dictionary::Base, 10);
-    dict.write(Dictionary::Here, Dictionary::Begin);
-    dict.write(Dictionary::Latest, Dictionary::Begin);
-    dict.write(Dictionary::Compiling, 0);
-    dict.write(Dictionary::Postpone, 0);
+    dict.initialize();

    std::vector args (argv + 1, argv + argc);
    for (const auto& a : args) {
@ -63,6 +60,8 @@ static void readchar(State& state)
        state.dict.writebyte(addr, state.dict.readbyte(addr + 1));

    auto c = std::cin.get();
+    if (isupper(c))
+        c += 32;
    state.dict.writebyte(addr, c ? c : ' ');
    state.dict.write(Dictionary::Input, len + 1);
 }
@ -88,19 +87,31 @@ static void load(State& state)

 void user_sys(State& state)
 {
+    char buf[32] = {0};
+
    switch (state.pop()) {
-    case 0:
-        std::cout << state.pop() << ' ';
+    case 0: // .
+        std::to_chars(buf, buf + sizeof(buf), state.pop(),
+                      state.dict.read(Dictionary::Base));
+        std::cout << buf << ' ';
        break;
-    case 1:
+    case 1: // emit
        std::cout << static_cast<char>(state.pop());
        break;
-    case 2:
+    case 2: // save
        save(state);
        break;
-    case 3:
+    case 3: // load
        load(state);
        break;
+    case 4: // u.
+        {
+        Addr ucell = static_cast<Addr>(state.pop());
+        std::to_chars(buf, buf + sizeof(buf), ucell,
+                      state.dict.read(Dictionary::Base));
+        std::cout << buf << ' ';
+        }
+        break;
    }
 }

@ -132,6 +143,12 @@ void parseLine(Parser& parser, State& state, const std::string& line)
            std::cout << "error: " << r << std::endl;
            break;
        }
+
+        while (state.size())
+            state.pop();
+        while (state.rsize())
+            state.popr();
+        state.dict.write(Dictionary::Compiling, 0);
    }
 }

@ -140,6 +157,7 @@ void parseFile(Parser& parser, State& state, std::istream& file)
    while (file.good()) {
        std::string line;
        std::getline(file, line);
+
        if (line == "bye")
            exit(0);

--- a/core.fth
+++ b/core.fth
@ -1,16 +1,19 @@
 : *        m* drop ;
-: /        0 swap _/ ;
-: %        0 swap _% ;
+: s>d      1 m* ;
+: /        >r s>d r> _/ ;
+: %        >r s>d r> _% ;

 : cell+    2 + ;
 : cells    2 * ;

 : .        0 sys ;
 : emit     1 sys ;
+: u.       4 sys ;

 : 1+       1 + ;
 : 1-       1 - ;

+: '        _' drop ;
 : !        1 _! ;
 : @        1 _@ ;
 : +!       dup >r swap r> @ + swap ! ;
@ -19,13 +22,27 @@
 : here     1 cells @ ;
 : allot    1 cells +! ;
 : _latest  2 cells ;
-: imm      _latest @ dup @ 1 6 << | swap ! ;
+: imm      _latest @ dup @ 1 5 << | swap ! ;
+: immediate imm ;
 : state    3 cells ;
-: postpone 1 4 cells ! ; imm
-: _input   5 cells ;
+: _input   4 cells ;

 : ,        here ! 1 cells allot ;

+: [        0 state ! ; imm
+: ]        1 state ! ;
+
+: literal  [ ' _lit dup , , ] , , ; imm
+: [']      ' [ ' literal , ] ; imm
+
+: if       ['] _jmp0 , here 0 , ; imm
+: then     here swap ! ; imm
+: else     ['] _jmp , here 0 , swap here swap ! ; imm
+
+: postpone _' dup 0 = if exit then
+           1 = swap ['] _lit , , if ['] execute ,
+           else ['] , , then ; imm
+
 : over     1 pick ;
 : rot      >r swap r> swap ;
 : -rot     rot rot ;
@ -46,11 +63,6 @@
 : decimal  10 base ! ;
 : hex      16 base ! ;

-: literal  1 , , ; imm
-: [']      ' postpone literal ; imm
-: [        0 state ! ; imm
-: ]        1 state ! ;
-
 : 2r>      ['] r> , ['] r> , ['] swap , ; imm
 : 2>r      ['] swap , ['] >r , ['] >r , ; imm
 : 2r@      ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
@ -61,16 +73,12 @@

 : 0=       0 = ;
 : 0<       0 < ;
-: <=       - 1- 0< ;
+: <=       2dup < >r = r> | ;
 : >        swap < ;
 : <>       = 0= ;
 : 0<>      0= 0= ;
 : 0>       0 > ;

-: if       ['] _jmp0 , here 0 , ; imm
-: then     here swap ! ; imm
-: else     ['] _jmp , here 0 , here rot ! ; imm
-
 : begin    0 here ; imm
 : while    swap 1+ swap postpone if -rot ; imm
 : repeat   ['] _jmp , , if postpone then then ; imm
@ -81,21 +89,20 @@
 : ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
           postpone then postpone 2>r here ; imm
-: unloop   postpone 2r> ['] 2drop , ; imm
-: leave    postpone unloop postpone 2r>
+: unloop   postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm
+: leave    postpone 2r> ['] 2drop , postpone 2r>
           ['] drop , ['] >r , ['] exit , ; imm
 : +loop    postpone 2r> ['] 2dup , ['] swap , ['] < , ['] >r ,
           ['] rot , ['] + , ['] 2dup , ['] swap , ['] < ,
           ['] r> , ['] ^ , ['] -rot ,
           postpone 2>r ['] _jmp0 , ,
-           postpone unloop
-           here swap ! ['] r> , ['] drop , ; imm
+           postpone unloop here swap ! ; imm
 : loop     postpone 2r> ['] 1+ , ['] 2dup ,
           postpone 2>r ['] = , ['] _jmp0 , ,
-           postpone unloop
-           here swap ! ['] r> , ['] drop , ; imm
+           postpone unloop here swap ! ; imm
 : i        postpone r@ ; imm 
-: j        postpone 2r> postpone r@ ['] -rot , postpone 2>r ; imm
+: j        postpone 2r> ['] r> , postpone r@ ['] swap ,
+           ['] >r , ['] -rot , postpone 2>r ; imm

 : align    here 1 cells 1- tuck & if 1 cells swap - allot else drop then ;
 : aligned  dup 1 cells 1- tuck & if 1 cells swap - + else drop then ;
@ -108,10 +115,10 @@
 : invert   -1 ^ ;
 : mod      % ;
 : 2*       2 * ;
-: 2/       2 / ;
+: _msb     1 1 cells 8 * 1- << ;
+: 2/       dup 1 >> swap 0< if _msb or then ;

 : /mod     2dup % -rot / ;
-: s>d      1 m* ;
 : */       >r m* r> _/ ;
 : */mod    >r m* 2dup r@ _% r> _/ ;
 : sm/rem   >r 2dup r@ _% -rot r> _/ ;
@ -162,10 +169,8 @@

 : create   align here bl word count nip cell+ allot align
           ['] _lit , here 3 cells + , ['] exit dup , ,
-           dup @ 31 & over _latest @ - 7 << or over ! _latest ! ;
-: _latword _latest @
-           dup @ 31 & + cell+ aligned ;
-: _does>   _latword 2 cells +
+           dup @ 31 & over _latest @ - 6 << or over ! _latest ! ;
+: _does>   _latest @ dup @ 31 & + cell+ aligned 2 cells +
           ['] _jmp over ! cell+
           r@ 1 cells - @ swap ! ;
 : does>    ['] _jmp , here 2 cells + dup , 2 cells + ,
@ -196,12 +201,14 @@
           postpone if ['] type , ['] abort ,
           postpone else ['] 2drop , postpone then ; imm

-: recurse  _latword , ; imm
+: recurse  depth 1- pick dup @ 31 & + cell+ aligned , ; imm

-: move     begin dup 0 > while
-           rot dup @ >r 1+
-           rot r> over ! 1+
-           rot 1- repeat drop 2drop ;
+: move     dup 0 <= if drop 2drop exit then
+           >r 2dup < r> swap if
+           1- 0 swap do over i + c@ over i + c! -1 +loop
+           else
+           0 do over i + c@ over i + c! loop
+           then 2drop ;
 : fill     -rot begin dup 0 > while
           >r 2dup c! char+ r> 1- repeat
           2drop drop ;
--- a/corewords.cpp
+++ b/corewords.cpp
@ -30,40 +30,29 @@ Word getword(State& state)
    }
    return word;
 }
-void newdef(Dictionary& dict, Word word)
+void newdef(State& state, Word word)
 {
+    auto& dict = state.dict;
+
    auto addr = dict.alignhere();
    dict.addDefinition(word);
-    dict.write(addr,
-        (dict.read(addr) & 0x1F) |
-        ((addr - dict.latest()) << 7));
-    dict.latest(addr);
+    state.push(addr);
 };
 void tick(State& state)
 {
    auto word = getword(state);
-    if (auto j = state.dict.find(word); j > 0)
+    if (auto j = state.dict.find(word); j > 0) {
        state.push(state.dict.getexec(j));
-    else if (auto i = CoreWords::findi(state, word); i >= 0)
-        state.push(((i & ~CoreWords::Immediate) << 1) | 1);
-    else
+        auto imm = state.dict.read(j) & CoreWords::Immediate;
+        state.push(imm ? 1 : -1);
+    } else if (auto i = CoreWords::findi(state, word); i >= 0) {
+        state.push(i);
+        state.push(i == CoreWords::Semicolon ? 1 : -1);
+    } else {
+        state.push(0);
        state.push(0);
+    }
 }
-//    auto addr = state.pop();
-//    auto count = state.dict.read(addr++);
-//    Word word (addr, addr + count);
-//
-//    if (auto j = state.dict.find(word); j > 0) {
-//        state.push(state.dict.getexec(j));
-//        auto imm = state.dict.read(ins) & CoreWords::Immediate;
-//        state.push(imm ? 1 : -1);
-//    } else if (auto i = CoreWords::findi(state, word); i >= 0) {
-//        state.push(((i & ~CoreWords::Immediate) << 1) | 1);
-//        state.push((i & CoreWords::Immediate) ? 1 : -1);
-//    } else {
-//        state.push(addr);
-//        state.push(0);
-//    }

 void CoreWords::run(unsigned int index, State& state)
 {
@ -71,14 +60,14 @@ void CoreWords::run(unsigned int index, State& state)
    DoubleCell dcell;

 execute:
-    if ((index & 1) == 0) {
+    if (/*(index & 1) == 0 &&*/ index >= WordCount) {
        // must be calling a defined subroutine
        state.pushr(state.ip);
        state.ip = index;
        return;
-    } else switch ((index & 0x3E) >> 1) {
+    } else switch (index & 0x1F) {
    case 0: // _lit
-        state.push((index & 0xFF00) ? (index >> 8) - 1 : state.beyondip());
+        state.push(/*(index & 0xFF00) ? ((Addr)index >> 8u) - 1 :*/ state.beyondip());
        break;
    case 1: // drop
        state.pop();
@ -144,11 +133,11 @@ execute:
        break;
    case 15: // equal
        cell = state.pop();
-        state.top() = state.top() == cell;
+        state.top() = state.top() == cell ? -1 : 0;
        break;
    case 16: // lt
        cell = state.pop();
-        state.top() = state.top() < cell;
+        state.top() = state.top() < cell ? -1 : 0;
        break;
    case 17: // and
        cell = state.pop();
@ -164,14 +153,14 @@ execute:
        break;
    case 20: // shl
        cell = state.pop();
-        state.top() <<= cell;
+        reinterpret_cast<Addr&>(state.top()) <<= static_cast<Addr>(cell);
        break;
    case 21: // shr
        cell = state.pop();
-        state.top() >>= cell;
+        reinterpret_cast<Addr&>(state.top()) >>= static_cast<Addr>(cell);
        break;
    case 22: // colon
-        newdef(state.dict, getword(state));
+        newdef(state, getword(state));
        state.compiling(true);
        break;
    case 23: // tick
@ -188,8 +177,16 @@ execute:
        }
        break;
    case 26: // semic
-        state.dict.add((findi("exit") << 1) | 1);
+        {
+        state.dict.add(findi("exit"));
        state.compiling(false);
+
+        auto addr = state.pop();
+        state.dict.write(addr,
+            (state.dict.read(addr) & 0x1F) |
+            ((addr - state.dict.latest()) << 6));
+        state.dict.latest(addr);
+        }
        break;
    case 27: // _jmp0
        if (state.pop()) {
--- a/corewords.hpp
+++ b/corewords.hpp
@ -29,7 +29,7 @@ class CoreWords
 public:
    constexpr static std::size_t WordCount = 32;

-    constexpr static Cell Immediate = (1 << 6);
+    constexpr static Cell Immediate = (1 << 5);

    constexpr static int Semicolon = 26;

@ -43,7 +43,7 @@ private:
        "+\0-\0m*\0_/\0_%\0"
        "_@\0_!\0>r\0r>\0=\0"
        "<\0&\0|\0^\0"
-        "<<\0>>\0:\0'\0execute\0"
+        "<<\0>>\0:\0_'\0execute\0"
        "exit\0;\0_jmp0\0_jmp\0"
        "depth\0_rdepth\0_in\0";
 };
--- a/dictionary.cpp
+++ b/dictionary.cpp
@ -21,6 +21,14 @@
 #include <cctype>
 #include <cstring>

+void Dictionary::initialize()
+{
+    write(Base, 10);
+    write(Here, Begin);
+    write(Latest, Begin);
+    write(Compiling, 0);
+}
+
 Addr Dictionary::allot(Cell amount) noexcept
 {
    Addr old = here();
@ -62,7 +70,7 @@ Addr Dictionary::find(Word word) noexcept
    Addr lt = latest(), oldlt;
    do {
        oldlt = lt;
-        const Cell l = read(lt);
+        const auto l = static_cast<Addr>(read(lt));
        const Addr len = l & 0x1F;
        const Word lw {
            static_cast<Addr>(lt + sizeof(Cell)),
@ -72,7 +80,7 @@ Addr Dictionary::find(Word word) noexcept
        if (equal(word, lw))
            return lt;
        else
-            lt -= l >> 7;
+            lt -= l >> 6;
    } while (lt != oldlt);

    return 0;
@ -118,8 +126,15 @@ bool Dictionary::equal(Word word, const char *str, unsigned len) const noexcept
        return false;

    for (auto w = word.start; w != word.end; ++w) {
-        if (readbyte(w) != *str)
+        auto wc = readbyte(w);
+        if (wc != *str) {
+            if (isalpha(wc) && isalpha(*str) && (wc | 32) == (*str | 32)) {
+                ++str;
+                continue;
+            }
+
            return false;
+        }

        ++str;
    }
@ -134,8 +149,15 @@ bool Dictionary::equal(Word word, Word other) const noexcept

    auto w = word.start, o = other.start;
    while (w != word.end) {
-        if (readbyte(w) != readbyte(o))
+        auto wc = readbyte(w), oc = readbyte(o);
+        if (wc != oc) {
+            if (isalpha(wc) && isalpha(oc) && (wc | 32) == (oc | 32)) {
+                ++w, ++o;
+                continue;
+            }
+
            return false;
+        }

        ++w, ++o;
    }
--- a/dictionary.hpp
+++ b/dictionary.hpp
@ -31,10 +31,11 @@ public:
    constexpr static Addr Here       = sizeof(Cell);
    constexpr static Addr Latest     = sizeof(Cell) * 2;
    constexpr static Addr Compiling  = sizeof(Cell) * 3;
-    constexpr static Addr Postpone   = sizeof(Cell) * 4;
-    constexpr static Addr Input      = sizeof(Cell) * 5; // len data...
+    constexpr static Addr Input      = sizeof(Cell) * 4; // len data...
    constexpr static Addr InputCells = 80; // bytes!
-    constexpr static Addr Begin      = sizeof(Cell) * 6 + InputCells;
+    constexpr static Addr Begin      = sizeof(Cell) * 5 + InputCells;
+
+    void initialize();

    Addr here() const noexcept { return read(Here); }
    void here(Addr l) noexcept { write(Here, l); }
--- a/memdict.hpp
+++ b/memdict.hpp
@ -22,7 +22,7 @@
 #include "dictionary.hpp"

 #ifndef MEMDICTSIZE
-#define MEMDICTSIZE (4096)
+#define MEMDICTSIZE (65536)
 #endif
 constexpr unsigned long int MemDictSize = MEMDICTSIZE;

--- a/parser.cpp
+++ b/parser.cpp
@ -59,27 +59,19 @@ int Parser::parseWord(State& state, Word word)
    if (ins <= 0) {
        ins = CoreWords::findi(state, word);

-        if (ins < 0) {
+        if (ins < 0)
            return parseNumber(state, word);
-        } else {
+        else
            imm = ins == CoreWords::Semicolon;
-            ins &= ~CoreWords::Immediate;
-            ins = (ins << 1) | 1;
-        }
    } else {
        imm = state.dict.read(ins) & CoreWords::Immediate;
        ins = state.dict.getexec(ins);
    }

-    if (state.dict.read(Dictionary::Postpone)) {
-        state.dict.add(ins);
-        state.dict.write(Dictionary::Postpone, 0);
-    } else if (state.compiling() && !imm) {
+    if (state.compiling() && !imm)
        state.dict.add(ins);
-    } else {
-        if (auto stat = state.execute(ins); stat != State::Error::none)
-            return static_cast<int>(stat);
-    }
+    else if (auto stat = state.execute(ins); stat != State::Error::none)
+        return static_cast<int>(stat);

    return 0;
 }
@ -93,19 +85,20 @@ int Parser::parseNumber(State& state, Word word)
    buf[i] = '\0';

    auto base = state.dict.read(0);
-    Cell l;
-    auto [ptr, ec] = std::from_chars(buf, buf + i, l, base);
+    DoubleCell dl;
+    auto [ptr, ec] = std::from_chars(buf, buf + i, dl, base);
+    Cell l = static_cast<Cell>(dl);

    if (ec == std::errc() && ptr == buf + i) {
        if (state.compiling()) {
-            auto ins = (CoreWords::findi("_lit") << 1) | 1;
+            auto ins = CoreWords::findi("_lit");

-            if (l >= 0 && l < 0xFF) {
-                state.dict.add(ins | ((l + 1) << 8));
-            } else {
+            //if (l >= 0 && l < 0xFF) {
+            //    state.dict.add(ins | ((l + 1) << 8));
+            //} else {
                state.dict.add(ins);
                state.dict.add(l);
-            }
+            //}
        } else {
            state.push(l);
        }
--- a/test/core.fr
+++ b/test/core.fr
--- a/test/tester.fr
+++ b/test/tester.fr
@ -0,0 +1,66 @@
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST  
+
+\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
+\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
+\ VERSION 1.2
+
+\ 24/11/2015 Replaced Core Ext word <> with = 0=
+\ 31/3/2015 Variable #ERRORS added and incremented for each error reported.
+\ 22/1/09 The words { and } have been changed to T{ and }T respectively to
+\ agree with the Forth 200X file ttester.fs. This avoids clashes with
+\ locals using { ... } and the FSL use of } 
+
+HEX
+
+\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
+\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
+VARIABLE VERBOSE
+   FALSE VERBOSE !
+\   TRUE VERBOSE !
+
+: EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
+   DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
+
+VARIABLE #ERRORS 0 #ERRORS !
+
+: ERROR      \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
+      \ THE LINE THAT HAD THE ERROR.
+   CR TYPE SOURCE TYPE       \ DISPLAY LINE CORRESPONDING TO ERROR
+   EMPTY-STACK               \ THROW AWAY EVERY THING ELSE
+   #ERRORS @ 1 + #ERRORS !
+\   QUIT  \ *** Uncomment this line to QUIT on an error
+;
+
+VARIABLE ACTUAL-DEPTH         \ STACK RECORD
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
+
+: T{      \ ( -- ) SYNTACTIC SUGAR.
+   ;
+
+: ->      \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
+   DEPTH DUP ACTUAL-DEPTH !      \ RECORD DEPTH
+   ?DUP IF            \ IF THERE IS SOMETHING ON STACK
+      0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
+   THEN ;
+
+: }T      \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
+      \ (ACTUAL) CONTENTS.
+   DEPTH ACTUAL-DEPTH @ = IF      \ IF DEPTHS MATCH
+      DEPTH ?DUP IF         \ IF THERE IS SOMETHING ON THE STACK
+         0  DO            \ FOR EACH STACK ITEM
+           ACTUAL-RESULTS I CELLS + @   \ COMPARE ACTUAL WITH EXPECTED
+           = 0= IF S" INCORRECT RESULT: " ERROR LEAVE THEN
+         LOOP
+      THEN
+   ELSE               \ DEPTH MISMATCH
+      S" WRONG NUMBER OF RESULTS: " ERROR
+   THEN ;
+
+: TESTING   \ ( -- ) TALKING COMMENT.
+  SOURCE VERBOSE @
+   IF DUP >R TYPE CR R> >IN !
+   ELSE >IN ! DROP [CHAR] * EMIT
+   THEN ;
+