Building Retro

1. OUTPUT meta.rx
2. OUTPUT kernel.rx
3. Building Retro
4. [8/11] Stage 1: The Metacompiler
5. [3/14] Stage 2: The Kernel
6. [7/35] Stage 3: Extend The Language
7. [0/10] Appendix: Core Libraries
8. Appendix: Cleanup, save, and power off
- 8.1. -
- 8.2. ( cleanup and save ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
9. END
10. tasklist
- 10.1. TODO make okmsg assignable, in case you just want to change the string.
  - 10.1.1. perhaps this means using strings with known lengths
11. NOTE . the new w: scheme for building the dictionaries

NOTE: This commentary was written by crc for the initial 11.0 release of Retro. Some things in the implementation have changed since then. Even so, this should help with understanding most of the internals.

1 OUTPUT `meta.rx`

( Retro ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2008 - 2012, Charles Childers                                 )
( Copyright [c] 2009 - 2010, Luke Parrish                                     )
( Copyright [c] 2010,        Marc Simpson                                     )
( Copyright [c] 2010,        Jay Skeer                                        )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

2 OUTPUT `kernel.rx`

( Retro ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2008 - 2012, Charles Childers                                 )
( Copyright [c] 2009 - 2010, Luke Parrish                                     )
( Copyright [c] 2010,        Marc Simpson                                     )
( Copyright [c] 2010,        Jay Skeer                                        )
( Copyright [c] 2012,        Michal J Wallace                                 )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

3 Building Retro

The process of building a new retroImage is a straightforward, though not trivial, process. It involves several stages, and some tricks. This is a commentary on the code, which should help make the process easier to understand.

4 `[8/11]` Stage 1: The Metacompiler

4.1 DONE Introduction

The first of the three stages of Retro is the metacompiler. This comprises the assembler and secondary compiler, and is used to create a new image. There are some tricky things:

The target memory is allocated
But all pointers compiled in it need to be adjusted to be relative to zero, so it'll continue working after replacing the old image
We can't know the locations of the class handler until we are finished laying down a fair portion of the new kernel
When we move the image to overwrite the old one, we can't rely on any code locations in either image

So let's begin.

4.2 DONE `IMAGE-SIZE`

36 1024 * constant IMAGE-SIZE

This just specifies how much memory to set aside for the initial kernel built by the metacompiler. If you need to increase, it's safer to increase in small increments and rebuild rather than trying a big jump. (Large increases can cause the new image to overwrite the bootNew routine, which is an easy way to generate a badly corrupted image.)

4.3 DONE variables

variables| target origin 'WORD 'MACRO 'DATA 'PRIM link chain latest |

A list of variables used by the metacompiler.

target	Holds a pointer to the next free address in the target memory. This is similar to "heap"
origin	Holds a pointer to the start of the target memory
'WORD	Holds a pointer to the .word class
'MACRO	Holds a pointer to the .macro class
'DATA	Holds a pointer to the .data class
link	Holds pointer to prior entry (for initial dictionary)
chain	Holds pointer to variable that will become "last"
latest	Holds pointer to most recently defined entry

4.4 DONE allocate ram for new image

here [ !target ] [ !origin ] bi IMAGE-SIZE allot

Starting at here, allocate space for the new image, set target and origin to point to it.

4.5 DONE target memory writer

: m,  ( n-  ) @target !+ !target ;

This is like "," but it writes the value to the target memory instead of the standard heap. Each time it's called, "target" is increased by one.

4.6 DONE assembler

4.6.1 DONE def vm:

: vm: ( n"- ) ` : .data ` m, ` ;

This is used to build functions that lay down opcodes into the target memory space. Functionally, the following forms would be equivilent:

  0 vm: nop,

:  nop, 0 m, ;

The use of vm: helps keep things a bit more readable though, so it is preferred to do it this way.

4.6.2 DONE opcode assemblers

 0 vm: nop,          1 vm: lit,          2 vm: dup,
 3 vm: drop,         4 vm: swap,         5 vm: push,
 6 vm: pop,          7 vm: loop,         8 vm: jump,
 9 vm: ;,           10 vm: >jump,       11 vm: <jump,
12 vm: !jump,       13 vm: =jump,       14 vm: @,
15 vm: !,           16 vm: +,           17 vm: -,
18 vm: *,           19 vm: /mod,        20 vm: and,
21 vm: or,          22 vm: xor,         23 vm: <<,
24 vm: >>,          25 vm: 0;           26 vm: 1+,
27 vm: 1-,          28 vm: in,          29 vm: out,
30 vm: wait,

Create functions for laying down each opcode. This is pretty easy to grasp. The number is the opcode number (in decimal), and the names all end with a comma to distinguish them from higher-level functions.

4.7 `[8/9]` metacompler words

4.7.1 DONE def t-here

: t-here      (  -n ) @target @origin - ;

Like here, but returns a pointer in the target buffer. The pointer is set relative to origin, not the physical start of the target buffer.

4.7.2 DONE def pad

: pad         (  -  ) 32 @origin + !target ;

Used to ensure that function addresses are greater than the number of opcodes.

4.7.3 DONE def endKernel

: endKernel   (  -  )
  t-here "\nKernel ends @ %d\n" puts
  IMAGE-SIZE t-here - "%d cells free" puts
  depth 1 >= [ "\nError in stack depth!: " puts .s ] ifTrue ;

This is called at the end of the initial kernel. It does some sanity checks on the stack depth and displays some statistics on the size of the kernel.

4.7.4 DONE def main:

: main:       (  -  ) t-here [ "\nMAIN @ %d" puts ] [ @origin 1+ ! ] bi ;

This is called to mark the main entry point in the image. It replaces the jump at the image start with a jump to the code that follows it.

4.7.5 DONE def label:

: label:      ( "-  ) t-here constant ;

Create a symbolic name pointing to something in the target space, with the pointer being relative to origin.

4.7.6 DONE def #

: #           ( n-  ) lit, m, ;

This is used to compile a value as a literal. In normal definitons you'd just do:

:  foo 1 2 + ;

However, the classes are not aware of the target image. So we manually tell Retro to compile them.

:  foo 1 # 2 # + ;

This continues with the next function:

4.7.7 DONE def __#

: __#         ( $-  ) lit, toNumber m, ; parsing

This is a parsing prefix; it serves as a shortcut for numbers. Instead of doing:

1 # 2 #

We can do:

#1 #2

Which I find a bit cleaner.

4.7.8 DONE def $,

: $,          ( $-  ) withLength [ @+ m, ] times 0 m, drop ;

Copy a string from the current image into the target memory space.

The above finishes off what I consider the core of the assembler. The code then moves on to extend this into a target compiler and machine forth dialect.

4.7.9 TODO def shrink

: shrink      (  -  ) t-here "\nShrinking kernel to %d cells\n" puts
                      t-here @origin 6 + ! t-here @origin 3 + ! ;

4.8 TODO Metacompiler

4.8.1 TODO def t: and i: { t: is done, but add a note about i: }

{{
  : <self-compile>  &m, reclass ;
---reveal---
  : t: ( "- ) label: <self-compile> nop, nop, ;
  : i: ( "- ) label: <self-compile> ;
}}

Since : creates a dictionary header in the current image, we can't use it to create functions in the target. We define t: (for "target :") to create a label, compile two nop instructions, and then change the label's class to call "m,"

Since the Retro VM is direct threaded, this basically makes a function in the target compile a call to itself when referenced. The following forms would be functionally identical:

( without t: or # )
label: foo  lit, 1 m, lit, 2 m, ;, ;,
label: bar ' foo m, ;, ;,

( with t: and # )
t: foo #1 #2 ;, ;,
t: bar foo ;, ;,

As can be seen, the second is much more compact and readable.

4.8.2 NOTE: the end-of-function marker

Note the double ;, at the end of the functions. Retro 11 expects colon definitions to end in a double return. This could be stripped out to save space, but some of the debugging tools (such as dissect' and autopsy.rx) require this to locate the end of a function in memory.

Later on a modified ";" is defined to do this for us.

4.8.3 TODO def { =if <if >if !if then }

{{
  : cond ( -a ) @target 0 m, ;
---reveal---
  : =if  ( -a ) !jump, cond ;
  : <if  ( -a ) >jump, cond ;
  : >if  ( -a ) <jump, cond ;
  : !if  ( -a ) =jump, cond ;
  : then ( a- ) t-here swap ! ;
}}

Primitive conditionals mapping to the VM conditional jumps. Since the initial kernel does not support quotes, this is used to allow for any required comparision or flow control.

4.8.4 def `jump:`

: jump:  ( "-  ) jump, ' m, ;

Compile a jump instruction into the target memory. This is used in a couple of places to keep the address stack shallow, and to improve performance slightly.

4.8.5 DONE def `repeat` / `again`

: repeat (  -a ) t-here ;
: again  ( a-  ) jump, m, ;

We redefine repeat/again to work in the target memory instead of the current image.

4.8.6 TODO tallot

: tallot  ( n- ) [ 0 m, ] times ;

4.8.7 DONE variable factories

: variable: ( n"- ) label: m, ;
: variable  (  "- ) 0 variable: ;
: elements  ( n"- ) &variable times ;

Create labels pointing to data in the target image. These correspond to the identically named functions in the current image.

4.9 `[3/6]` functions to build the initial dictionary

4.9.1 TODO def entry word: data: { are these obsolete given p: w: m: ? and where is macro ??}

A big round of functions used to create the initial dictionary in the new kernel. Taking these one at a time:

: entry     ( a"- ) t-here dup !latest @link m, !link m, m, 0 m, getToken $, ;

Given a pointer, a class, and a string with the name, create a new header. Generally this should not be used directly; instead use "word:", "macro:", and "data:"

: word:     ( a"- ) @'WORD  entry ;

Given a pointer, parse for a name and create a header with a class of ".word"

{ macro ??? }

Given a pointer, parse for a name and create a header with a class of ".macro"

: data:     ( a"- ) @'DATA  entry ;

Given a pointer, parse for a name and create a header with a class of ".data"

4.9.2 TODO def p: w: m:

: w:        ( ""- )
  t-here dup !latest @link m, !link @'WORD m, t-here 0 m, 0 m, getToken $, t-here swap @origin + ! t: ;

: p:        ( ""- )
  t-here dup !latest @link m, !link @'PRIM m, t-here 0 m, 0 m, getToken $, t-here swap @origin + ! t: ;

: m:        ( ""- )
  t-here dup !latest @link m, !link @'MACRO m, t-here 0 m, 0 m, getToken $, t-here swap @origin + ! t: ;

4.9.3 TODO def :doc

: :doc
  t-here [ $, ] dip @latest @origin + 3 + ! ;

4.9.4 DONE def patch

: patch     (   - ) @link [ @chain ! ] [ "\nLast header at %d" puts ] bi ;

You should call "patch" at the end of the kernel source to seal the initial dictionary. Once that's done, relocation should be possible.

4.9.5 DONE def mark

: mark      (   - ) @target !chain ;

Mark the cell at t-here as the variable that will corespond with "last". This variable is set later by…

4.9.6 DONE def setClass

: setClass  ( aa- ) ! ;

Now we run into a problem. We can create headers, but the class locations aren't easily knowable. We get around this by using setClass to assign the ='WORD= ='MACRO= and ='DATA= variables to the class handlers we create.

4.10 DONE Image Relocator

{{
  : for      ( n-   )  here 5 , ; compile-only
  : next     (  -   )  6 , 7 , , ; compile-only
  : @+       ( a-ac )  dup 1+ swap @ ;
  : !+       ( ca-a )  dup 1+ push ! pop ;
  : copy     ( aan- )  for push @+ pop !+ next drop drop ;
  : wait     ( - )     0 0 out [[ 30 , ]] ;
  : save     ( - )     1 4 out 0 0 out wait ;
  : relocate ( - )     origin @ 0 IMAGE-SIZE copy ;
---reveal---
  : bootNew  ( - )     relocate save 0 push ;
}}

This bit is hairy. Once the target image is created, we need to replace the original image with the new one. This involves reading it cell by cell, and writing it to the main memory, starting at address zero. Pretty straightforward.

However there is a catch. Since the new image will (generally) differ from the old one, this code can not call anything in the old or new images.

So, to make this work, I define all needed factors using only primitives and macros that inline raw Ngaro bytecode. The mechanics here are murky, but I've not found a better solution yet.

Once "bootNew" finishes relocating the kernel it saves the new image file and uses a trick ("0 push ;") to jump to the new image. Assuming that there are no serious bugs, the new image should be ready to extend.

If anything does go wrong you may have to manually kill the VM and restore the image from a clean backup.

4.11 TODO Avoid keymap issues

devector keymap:handler

4.12 DONE Setup target memory for new image

: ; ( - ) ;, ;, ;; [[

Ok, now this one is the last definition in the metacompiler. We redefine ";" to lay down two return instructions (";,"), and then end the definition and exit the compiler manually (using ";; [[").

TIP: If you are pressed for space, you can save a fair amount of memory by removing the second ";," here.

One final bit:

jump, 0 m,
reset

Compile a jump instruction, with a target of zero. This will be modified later, by "main:". And finally, "reset" to ensure the data stack is in a clean state.

5 `[3/14]` Stage 2: The Kernel

5.1 `[0/1]` Layout of the Image

5.1.1 TODO `{ update this text to reflect the new situation for TIB }`

IMAGE-SIZE  constant CORE
CORE 0000 + constant HEAP

IMAGE-SIZE constant CORE CORE 0000 + constant TIB TIB 512 + constant HEAP

Create a few constants, which determine the basic memory layout. It looks like:

0	Start of memory. The kernel goes here
0 + IMAGE-SIZE	End of kernel, start of TIB (text input buffer)
TIB + 512	Start of heap. This is set to TIB + 512 by default

If you need to save memory, reducing the TIB is a quick and easy way to do so. I'd leave it at least 81 characters long, but making it a bit longer than the longest strings you'll be creating is a good idea.

WARNING:

If you make TIB too small, you can overwrite non-kernel code as you type long strings. If you overwrite memory, you may need to exit and reload, or even restore the image from a backup in some cases.

5.2 `[2/4]` Initial Variables

At this point the metacompiler functions are created, there is space set aside for a new image, and things are ready to proceed. So on to the kernel.

5.2.1 DONE `last` .. `which`

mark variable last    ( Pointer to the most recent dictionary header          )
HEAP variable: heap   ( Starting address of the data/code heap                )
variable compiler     ( Is the compiler on or off?                            )
variable which        ( Pointer to dictionary header of the most recently     )
                      ( looked up word                                        )

These should be pretty easy to grasp. Note the use of mark to flag the last variable, which will be updated after the initial dictionary is created.

5.2.2 TODO |memory fb fw fh cw ch

6 elements memory fb fw fh cw ch

5.2.3 DONE copytag, version, build, okmsg

label: copytag   "Retro" $,
label: version   "11.5" $,
label: build     "2012.12.10" $,
label: okmsg     "ok  " $,

Some strings. "copytag" and "version" and "build" are displayed when Retro starts, while "okmsg" serves as the prompt for the listener.

5.2.4 TODO call pad { i think this moved up to the top ?? }

Ngaro assumes that addresses of functions will be greater than the number of opcodes. The "pad" function injects a bunch of NOP's to make sure that things are setup correctly.

The padding isn't always needed, but seems to help keep the rebuilds more stable if you are making changes to the kernel. (Specifically, it's there to ensure that no functions are located at addresses reserved for Ngaro bytecodes.)

5.3 TODO DEF , `{ the heap writer }`

t: ,           ( n-  ) heap # @, dup, 1+, push, !, pop, heap # !, ;

5.4 `[5/7]` classes

5.4.1 DONE DEF withClass

t: withClass   ( ac- ) 1-, push, ;

This is identical (by default) to do, but serves as a hook for gaining more control over how classes are handled

5.4.2 DONE DEF .word

t: .word       (  a- ) compiler # @, 0 # !if , ; then jump: withClass

The class handler for normal functions. If interpreting, execute the xt of the function. If the compiler is active, lay down a call to the xt instead.

5.4.3 DONE DEF .macro

t: .macro      (  a- ) jump: withClass

The core class for compiler macros. Basically "immediate" functions; this always calls the xt.

5.4.4 DONE DEF `.data`

t: .data       (  a- ) compiler # @, 0; drop, 1 # , , ;

The class handler for data structures. It either leaves the xt on the stack (if interpreting), or compiles it as a literal.

5.4.5 DONE DEF `.primitive`

t: .primitive  (  a- )
    dup, @, 0 # =if compiler # @, -1 # =if 2 # +, @, then then jump: .word

5.4.6 TODO classes for the words so far

' .macro     'MACRO setClass
' .data      'DATA  setClass
' .primitive 'PRIM  setClass

This bit assigns the classes to the variables that the metacompiler will later use when creating the initial dictionary. Without this, we'd have no easy way to reference the classes in the new kernel.

5.4.7 TODO docs for the words so far `{ looks like these can be inlined...? }`

' , word: ,
"( n- ) Place TOS **here** and increment **heap** by 1 " :doc

' withClass    word: withClass
"( ac- ) Execute a function via the specified class handler" :doc

' .word          word: .word
"( a- ) Class for normal functions" :doc

' .macro       word: .macro
"( a- ) Class for immediate functions" :doc

' .data          word: .data
"( a- ) Class for data (variables, literals, etc) " :doc

' .primitive   word: .primitive
"( a- ) Class for functions corresponding to VM opcodes; used for simple optimizations" :doc

5.5 TODO Primitives : `dup` .. `!+`

5.5.1 .

These are functions that map directly to Ngaro instructions. We will use the instructions directly in most cases (to save some overhead), but this serves to allow normal definitions to use them if desired.

5.5.2 stack operations

dup

p: dup dup dup, ;
"( n-nn ) Duplicate TOS" :doc

swap

p: swap swap swap, ;
"( xy-yx ) Exchange positions of TOS and NOS" :doc

drop

p: drop drop drop, ;
"( n- ) Drop TOS from the stack" :doc

5.5.3 bitwise operations { also logical operations since true is -1 }

and

p: and and and, ;
"( xy-n ) Bitwise AND" :doc

p: or or or, ;
"( xy-n ) Bitwise OR" :doc

xor

p: xor xor xor, ;
"( xy-n ) Bitwise XOR" :doc

5.5.4 memory operations

p: @ @ @, ;
"( a-n ) Fetch a value from a memory location" :doc

p: ! ! !, ;
"( na- ) Store a value to a memory location" :doc

5.5.5 arithmetic operations

p: + + +, ;
"( xy-n ) Add two values (x+y)" :doc

p: - - -, ;
"( xy-n ) Subtract two values (x-y)" :doc

p: * * *, ;
"( xy-n ) Multiply two values (x*y)" :doc

/mod

p: /mod /mod /mod, ;
"( xy-rq ) Divide and Remainder. This performs symmetric division" :doc

<< { shift left, or multiply by 2 }

p: << << <<, ;
"( xy-n ) Shift bits left (x<<y)" :doc

>> { shift right, or divide by 2 }

p: >> >> >>, ;
"( xy-n ) Shift bits right (x>>y)" :doc

p: 1-  1-  1-, ;
"( n-n ) Decrement TOS by 1 " :doc

p: 1+  1+  1+, ;
"( n-n ) Increment TOS by 1 " :doc

5.5.6 i/o operations

out

p: out out out, ;
"( np- ) Write a value to an I/O port" :doc

p: in in in, ;
"( p-n ) Read a value from an I/O port" :doc

5.6 `[2/9]` Additional stack, variable, and math functions.

5.6.1 DONE wait

w: wait wait 0 # 0 # out, wait, ;
"( - ) Wait for an I/O event" :doc

The "wait," instruction needs a bit of extra help to actually trigger an I/O event. This provides it.

5.6.2 TODO over

w: over over push, dup, pop, swap, ;
"( xy-xyx ) Place a copy of NOS over TOS" :doc

5.6.3 TODO not

w: not not -1 # xor, ;
"( x-y ) Same as -1 xor; invert TOS and subtract 1" :doc

5.6.4 TODO on

w: on on -1 # swap, !, ;
"( a- ) Set a variable to -1 (true)" :doc

5.6.5 TODO off

w: off off 0 # swap, !, ;
"( a- ) Set a variable to  0 (false)" :doc

5.6.6 TODO `/` and `mod`

w: / / /mod, swap, drop, ;
"( xy-q ) Divide two numbers (x/y)" :doc

w: mod mod /mod, drop, ;
"( xy-r ) Modulus of two numbers (x%y)" :doc

5.6.7 TODO negate

w: negate negate -1 # *, ;
"( x-y ) Invert sign of TOS" :doc

5.6.8 DONE do

w: do do 1-, push, ;
"( a- ) Call a function by address" :doc

This is used to invoke a function. The =1-,= is used to account for the way the VM increments the instruction pointer.

5.6.9 TODO @+ / !+

w: @+ @+ dup, 1+, swap, @, ;
"( a-ac ) Fetch a value from an address, return the next address and the value" :doc

w: !+ !+ dup, 1+, push, !, pop, ;
"( ca-a ) Store a value to an address, return next address" :doc

Rather handy functions for "fetch from and return next" and "store to and return next". This allows easy access to linear arrays or strings:

( an example of using @+ )
create array 1 , 2 , 3 ,
array @+ putn @+ putn @+ putn drop

5.7 TODO Core Compiler: `here` .. `pop`

Continuing on, we now have the core of the actual colon compiler:

w: here here heap # @, ;
"( -a ) Next free address in **heap**" :doc

m: ;; ;; 9 # , ;
"( - ) Compile an exit into a function, but do not stop compilation" :doc

m: ; t-;  ;; ;; compiler # off ;
"( - ) Compile an exit into a function and stop the compiler" :doc

i: ($,) repeat @+ 0; , again ;
( [ a-a ] internal helper function for inlining strings )

i: $ ($,) drop, 0 # , ;
( [ a- ] internal helper function for inlining strings )

m: push push 5 # , ;
"( n- ) Push a value to the address stack" :doc

m: pop  pop  6 # , ;
"( -n ) Pop a value off the address stack" :doc

5.7.1 | core compiler

t: here ( -a ) heap # @, ;
t: , ( n- ) here !+ heap # !, ;

Note the use of "!+" in ",". This is a clean way of implementing this functionality.
t: ;; ( - ) #9 , ;
t: t-; ( - ) ;; ;; compiler # off ;

For terminating definitions. These are exposed as ";;" and ";", respectively. We allow the "t-" prefix to avoid confusion with the ";" provided by the metacompiler.

TIP:

If you are pressed for space, you can save a fair amount of memory by removing the second ";;" here.

And back to the code:
t: ($,) ( a-a ) repeat @+ 0; , again ;
t: $ ( a- ) ($,) drop, #0 , ;

This is used to compile a string into memory. We'll see how it is used when we get to ":".

Since we lack any counted loops, the "($,)" has been factored out into a separate definition.
t: push ( n- ) #5 , ;
t: pop ( -n ) #6 , ;

These are exposed as macros; they lay down push, and pop, instructions when executed.

5.8 TODO Conditionals and Flow Control : `0;` .. `again`

m: 0; t-0; 25 # , ;
"( n-n || n- ) If TOS is not zero, do nothing. If TOS is zero, drop TOS and exit the function" :doc

m: repeat t-repeat here ;
"( R: - C: -a ) Start an unconditional loop" :doc

m: again t-again  8 # , , ;
"( R: -  C: a- ) Jump to the code following the most recent **repeat**" :doc

5.8.1 | conditionals / flow control

t: t-0; ( n-n || n- ) #25 , ;
t: t-repeat ( R: - C: -a ) here ;
t: t-again ( R: - C: a- ) #8 , , ;

Primitive flow control and conditionals. At this point we have to use these, as there's no quotes in the initial kernel.

Note the continued use of "t-" as a prefix to avoid confusion with the functions in the metacompiler.

Most of these will be hidden at the end of the core.rx source.

5.9 TODO Console Output

5.9.1 DONE DEF `update`

-1 variable: update

This variable is used to control whether or not the display is updated. On some VM implementations, you can improve performance by turning it "off" before writing large amounts of text to the screen, then "on" when done.

5.9.2 TODO def redraw - puts

w: redraw redraw update # @, 0; drop, 0 # 3 # out, ;
"( - ) Update the display. Can be disabled temporarily by **update**" :doc

w: putc putc 0; 1 # 2 # out, wait redraw ;
"( c- ) Display a character" :doc

w: cr cr 10 # putc ;
"( - ) Display a newline character" :doc

i: (puts) repeat @+ 0; putc again ;
( [ a-a ] helper for **puts** )

w: <puts> <puts> (puts) drop, ;
"( $- ) Helper; default way to display strings" :doc

w: puts puts <puts> ;
"( $- ) Display a string" :doc

5.10 TODO Console Input `break` / `keyXXX` .. `accept`

variable  break                       ( Holds the delimiter for 'accept'   )

-1 variable: remapping                   ( Allow extended whitespace?         )

-1 variable: eatLeading?                 ( Eat leading delimiters?            )

-1 variable: tabAsWhitespace

 0 variable: keymap
keymap data: keymap
"( -a ) Variable, determines whether or not to use the keymap" :doc

 9 variable: keymap:PREFIX
keymap:PREFIX data: keymap:PREFIX
"( -a ) Variable, holds prefix for triggering keymap lookups. Default is #9 (tab)" :doc

 0 variable: keymap:TABLE
256 tallot
keymap:TABLE data: keymap:TABLE
"( -a ) Variable, jump table for keymap handlers" :doc


w: STRING-LENGTH STRING-LENGTH  256 # ;
"( -n ) Return the max length for a string" :doc

w: STRING-BUFFERS STRING-BUFFERS 12 # ;
"( -n ) Return number of temporary string buffers" :doc

w: tib tib memory # @, STRING-LENGTH - ;
"(  -a ) Returns address of text input buffer" :doc

w: remapKeys remapKeys ;
"( c-c ) Remap one ASCII value to another" :doc

w: remap:whitespace remap:whitespace
   dup,  127 # =if drop,  8 # then
   dup,   13 # =if drop, 10 # then
   remapping # @, 0; drop,
   dup,   10 # =if drop, 32 # then
   tabAsWhitespace # @, 0; drop, dup, 9 # =if drop, 32 # then ;
"( c-c ) helper for remapping whitespace" :doc

w: getc:unfiltered getc:unfiltered 1 # 1 # out, wait 1 # in, ;
"( -c ) Read a keypress and return the ASCII value on the stack" :doc

w: getc:with/remap getc:with/remap
  repeat getc:unfiltered remapKeys dup, 0 # !if remap:whitespace ; then drop, again ;
"( -c ) Read a keypress and return the ASCII value on the stack.\nThis differs from **getc:unfiltered** in that the key value is processed\nby **remapKeys** before being returned.\nUnlike **getc** it does not attempt to support the keymaps." :doc

w: keymap:handler keymap:handler
  ;
"( c-c ) handle keymaps" :doc

w: getc getc
  repeat getc:unfiltered keymap:handler remapKeys dup, 0 # !if remap:whitespace ; then drop, again ;
"( -c ) Read a keypress and return the ASCII value on the stack.\nBoth remapping and keymaps are handled by this." :doc

i: putc? dup, 8 # =if drop, break # @, ; then dup, putc ;
( [ c-c ] helper to display characters and backspaces properly )

i: eat    ( a-a )
   eatLeading? # @, 0; drop,
   repeat getc putc? dup, break # @, !if swap, !+ ; then drop, again ;
( [ a-a ] helper function to eat leading delimiters )

i: guard? dup, 1+, tib <if drop, tib ; then 8 # putc ;
( [ n-n ] helper to prevent backspacing to before start of buffer )

i: (accept)
   repeat
     getc
     dup, 8 # =if drop, 1-, guard? jump: (accept) then
     dup, putc
     dup, break # @, =if drop, ; then
     swap, !+
   again ;
( [ a-a ] internal implementation of **accept** )

w: accept accept break # !, tib eat (accept) 0 # swap, !+ drop, ;
"( c- ) Read a string, ending with the specified character. The string is returned in **tib**" :doc

5.11 TODO | console input

5.11.1 t: redraw ( - ) update # @, 0; drop, #0 #3 out, ;

Attempt to flush the output buffers.

5.11.2 t: putc ( c- ) 0; #1 #2 out, wait redraw ;

Display an ASCII (or possibly unicode) character.

5.11.3 t: cr ( - ) #10 putc ;

Move the text cursor to the start of the next line.

5.11.4 t: (puts) ( a-a ) repeat @+ 0; putc again ;

5.11.5 t: <puts> ( a- ) (puts) drop, ;

5.11.6 t: puts ( a- ) <puts> ;

These are used to display a string. "(puts)" is not exposed to the global dictionary, but the others are. "<puts>" is replaced in stage 3 with code allowing for formatted output. Generally, user code should only call "puts".

variable break ( Holds the delimiter for 'accept' ) -1 variable: remapping ( Allow extended whitespace? ) -1 variable: eatLeading? ( Eat leading delimiters? ) -1 variable: tabAsWhitespace

These should be understandable by the comments.

5.11.7 t: tib ( -a ) TIB # ;

Return a pointer to the text input buffer. This allows for temporary (or long term) moving of the TIB to allow for longer strings.

5.11.8 t: remapKeys ( c-c ) ;

A hook to allow runtime remapping of one character to another during input.

5.11.9 t: ws ( c-c )

dup, #127 =if drop, #8 then dup, #13 =if drop, #10 then remapping # @, 0; drop, dup, #10 =if drop, #32 then tabAsWhitespace # @, #0 !if dup, #9 =if drop, #32 then then ;

Remapping of whitespace. Generally, this will take care of backspaces on OS X, cr/lf pairs under Windows, and optionally turn tabs into spaces.

5.11.10 t: <getc> ( -c ) #1 #1 out, wait #1 in, ;

5.11.11 t: getc ( -c ) repeat <getc> remapKeys dup #0 !if ws ; then drop, again ;

Read a key from the keyboard. This is exposed as "getc", and calls "remapKeys" and "ws" to remap things before returning them on the stack.

5.11.12 t: putc? ( n-n ) dup, #8 =if drop, break # @, ; then dup, putc ;

Display a character if not backspace.

5.11.13 t: eat ( a-a )

eatLeading? # @, 0; drop repeat getc putc? dup, break # @, !if swap, !+ ; then drop, again ;

If we want to discard leading delimiters, this will ignore input until it encounters a non-delimiter character.

5.11.14 t: guard? ( n-n ) dup, 1+, tib <if drop, tib ; then #8 putc ;

This is used to prevent backspaces from going before the start of the TIB.

5.11.15 t: (accept) ( a-a )

repeat getc dup, #8 =if drop, 1-, guard? jump: (accept) then dup, putc dup, break # @, =if drop, ; then swap, !+ again ;

5.11.16 t: accept ( c- ) break # !, tib eat (accept) #0 swap, !+ drop, ;

Read input into the TIB, ending when the delimiter is encountered.

5.12 `[7/8]` Colon Compiler : `vector` .. `( .. )`

5.12.1 DONE VAR vector

-1 variable: vector

5.12.2 DONE DEF { dictionary field accessors }

w: d->class d->class  1+, ;
"( a-a ) Given a dictionary header, return the address of the class handler. Use **@** to get the actual pointer." :doc

w: d->xt d->xt 1+, 1+, ;
"( a-a ) Given a dictionary header, return the address of the function start (*xt*). Use **@** to get the actual pointer." :doc

w: d->doc d->doc 3 # +, ;
"( a-a ) Given a dictionary header, return the address of a documentation string. Use **@** to get the actual pointer." :doc

w: d->name d->name  4 # +, ;
"( a-a ) Given a dictionary header, return the address of the name. This is the actual start of the  name." :doc

These are dictionary field accessors. Our dictionary is a linked list, with a structure of:

0	link to previous
1	class handler
2	xt
3+	name of function

The accessors give us a clean, and portable, way to access the various fields.

5.12.3 DONE DEF header

w: header header  push, here        ( Entry Start      )
                     last # @, ,       ( Link to previous )
                     last # !,         ( Set as newest    )
                     ' .data # ,       ( Class = .data    )
                     here 0 # ,        ( XT               )
                     0 # ,             ( Pointer to docstr)
                     pop, $            ( Name             )
                     here swap, !, ;   ( Patch XT to HERE )
"( $- ) Given a name, create a new header with a class of **.data**" :doc

Given a string, this creates a header pointing the xt to the cell following the header, and assigning a class of ".data" to it. This is used by:

5.12.4 DONE DEF create

w: create create 32 # accept tib header ;
"( ``- ) Parse for a name and call **header**" :doc

"create" which parses for a name, then creates the header. Note here that "accept" does not return a pointer to the tib; that is up to you to obtain if needed.

5.12.5 TODO DEF `:` { the "colon compiler" }

i: vector?  vector # @, 0; drop, 0 # , 0 # , ;

w: : :   create ' .word # last # @, d->class !, ]] vector? ;
"( ``- ) Calls **create**, changes class to **.word**, and turns **compiler** on." :doc

t: (:) ( - ) last # @, d->class !, compiler # on #0 , #0 , ; t: : ( "- ) create ' .word # (:) ;

The colon compiler in all it's glory. "create" a header, assign it a class of ".word", lay down two nop's (for revectoring purposes), and set the compiler to "on".

At this point we no longer need the old ":" from the old image, so we can reuse the name here, rather than start it off with a "t-" prefix.

5.12.6 DONE DEF `[[`

m: [[ [[ compiler # off ;
"( - ) Turn compiler off" :doc

5.12.7 DONE DEF `]]`

w: ]] ]] compiler # on ;
"( - ) Turn compiler on" :doc

5.12.8 DONE MACRO ( { the comment-ignorer }

m: ( t-(  ') # accept ;
"( ``- ) Parse for ) and ignore everything it reads" :doc

Allow for comments. Eats everything up to a ")", and then exits.

5.13 `[0/1]` Quotes : `quote` .. `[ .. ]`

5.13.1 TODO reference diagram

( Quotes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( reference diagram:                                           )
(                                                              )
(  step       generated code.                                  )
(  -------    ----------------                                 )
(  [          <quote> 0000                                     )
(  [ 5        <quote> 0000 <lit> 0005                          )
(  [ 5 ]      <quote> ADDR <lit> 0005 <ret>                    )
(                                                              )
( ADDR will be same as "here" immediately after compilation    )
(                                                              )
( <quote> is the xt for "quote" - 711 as of retro 11.5 . This  )
( changes with kernel/meta.rx but the number should always be  )
( the same as both:  ' quote     and:  d' quote @d->xt         )

5.13.2 def quote

w: quote quote ( -a  ) ( -- runtime -------------------------------- )
  pop, 1+        (   -a  | grab the return address, add 1, and )
  dup,           (  a-aa | dup, giving two pointers to ADDR    )
  @,             ( aa-aA | dereference one for actual target   )
  1-,            ( aa-aA | subtract 1 because ip++ in ngaro vm )
  push,          ( aA-a  | push result to do a calculated jump )
  1+, ;          (  a-a  | point to start of code, jump to end )
"( -a ) Helper function for quotations" :doc

5.13.3 def [

m: [ [ ( -a )      ( -- compile-time---------------------------- )
  ' quote # ,    (   -   | compile a call to quote             )
  here           (   -a  | remember where to put ADDR          )
  0 # ,          (  a-a  | leave a cell to hold it later       )
  compiler # @,  (  a-af | store current compiler state        )
  compiler # on  ( af-af | turn the compiler on                )
  ;
"( - ) Start a quote (code block)" :doc

TODO t: [ ( -naa ) compiler # @, #8 , here #0 , here compiler # on ;

5.13.4 def ]

m: ] ] ( af- ) ( a = placeholder for quote jump, f = old compile state  )
   ;;            ( af-af | compile a return from quoted code   )
   compiler # !, ( af-a  | restore compiler state              )
   here          (  a-aA | now we know what ADDR should be     )
   over !,       ( aA-a  | so go replace the 00                )
   compiler # @, (  a-af | recall current compile state        )
   0 # =if       ( af-a  | are we outside of the compiler?     )
                 ( -- runtime -------------------------------- )
     1+, ;       (  a-a  | for interactive, keep ptr to start  )
                 ( -- compile-time---------------------------- )
   then drop, ;  (  a-   | inside compile mode, just discard.  )
                 (       | the call to 'quote will restore it  )
                 (       | when the containing function runs   )
"( -a ) End a quote (code block)" :doc

TODO t: ] ( naa-q ) push, ;; here swap, !, compiler # !, pop, .data ;
Quotes are anonymous blocks of code. We create them using "[" and "]". The way they work is this:

[ does:
1. get a copy of the current compiler state
2. compile a jump to 0, leaving a pointer to the jump target on the stack
3. leave a pointer to the actual code start (after the jump) on the stack
4. turn the compiler on
] does:
1. move the pointer to the code in the quote out of the way
2. compile an exit (";;")
3. patch the jump ("here swap !")
4. restore the compiler to the saved state ("compiler !")
5. restore the pointer to the code in the quote, and call ".data"
And now on to the base set of combinators…

5.14 TODO Combinators

5.14.1 { empty } internal

i: empty ;
( [ - ] internal helper corresponding to an empty quote )

This serves as an empty quote, for use in cases where we may not have an actual action (e.g., "ifTrue", and "ifFalse")

5.14.2 t: dip ( nq-n ) swap, push, do pop, ;

The "dip" combinator replaces direct use of "push" and "pop" in many cases. E.g.,

( without dip ) 1 2 push 3 + pop

( with dip ) 1 2 [ 3 + ] dip

Moving on:

5.14.3 if / ifTrue / ifFalse

w: if if push, swap, pop, swap, 0 # !if drop, do ; then swap, drop, do ;
"( fqq- ) Execute first quote if flag is true, second  if false" :doc

w: ifTrue ifTrue   ' empty # if ;
"( fq- ) Execute quote if flag is true" :doc

w: ifFalse ifFalse ' empty # swap, if ;
"( fq- ) Execute quote if flag is false" :doc

Higher level conditional flow control. These execute quotes based on a flag left by a conditional function. (The conditional functions will be defined soon)

5.14.4 DEF `dip`

w: dip dip swap, push, do pop, ;
"( nq-n ) Call a quote while temporarily hiding the top item on the stack" :doc

5.14.5 DEF `sip`

w: sip sip over ' do # dip ;
"( nq-n ) Call a quote with an item on the stack, restoring that item after the quote returns" :doc

This replaces a dup push ... pop sequence:

( without sip )
1 dup push 3 + pop

( with sip )
1 [ 3 + ] sip

5.15 TODO Boolean constants and Relational Operators

5.15.1 true and false internal

i: false (  -n  )  0 # ;
( [ -f ] helper, returns 0 for false )

i: true  (  -n  ) -1 # ;
( [ -f ] helper, returns -1 for true )

And now for the promised conditionals:

5.15.2 def ==

w: =  =  ( xy-f  ) =if jump: true  then jump: false
"( xy-f ) Compare two values for equality. Use **==** instead" :doc

w: == == = ;
"( xy-f ) Compare two values for equality." :doc

5.15.3 def !=

w: <> <>  ( xy-f  ) !if jump: true  then jump: false
"( xy-f ) Compare two values for inequality. Use **!=** instead." :doc

w: != != <> ;
"( xy-f ) Compare two values for inequality." :doc

5.15.4 def comparisons

w: >= >=  ( xy-f  ) >if jump: true  then jump: false
"( xy-f ) Compare for greater than or equal to" :doc

w: <= <=  ( xy-f  ) <if jump: true  then jump: false
"( xy-f ) Compare for less than or equal to" :doc

w: < <    ( xy-f  ) >if jump: false then jump: true
"( xy-f ) Compare two values for less than" :doc

w: > >    ( xy-f  ) <if jump: false then jump: true
"( xy-f ) Compare two values for greater than" :doc

All pretty simple, and with names that should be familiar. Note that these are built using the VM instructions via the functions in the metacompiler.

5.16 `[4/6]` Strings

5.16.1 DONE def `compare`

w: compare compare
   repeat
     dup, @, push, 1+, swap,
     dup, @, push, 1+, pop, dup, pop,
     !if drop, drop, dup, xor, ; then
   0 # 12 m, m,
   drop, drop, -1 # ;
"( $$-f ) Compare two strings for equality" :doc

( [ a-a ] internal helper for getting string length )

Compare two strings. Yes, this is hairy. But it is much faster than a higher level implementation, and as one of the most heavily used functions in Retro, this pays off.

5.16.2 DONE def `getLength` / `withLength`

i: count repeat @+ 0; drop, again ;

w: getLength getLength   ( a-n ) dup, count 1-, swap, -, ;
"( a-n ) Return the length of a string" :doc

w: withLength withLength  ( a-an ) dup, getLength ;
"( a-an ) Same as **dup getLength**" :doc

Obtain the length of a string. count is not exposed, but the others are. Note here that withLength is the same as dup getLength; it was factored out to help reduce stack noise elesewhere.

5.16.3 DONE def `string`, `keepString`

w: string string      ( -   ) pop, count 1-, push, ;
"( - ) helper for strings" :doc

w: keepString keepString  ( a-a ) ' string # , here swap, $ ;
"( a-a ) Move the string to a permanent location" :doc

5.16.4 TODO `{ keepString commentary - seems to be outdated }`

t: keepString ( a-a ) withLength #3 +, here +, #8 , , here swap, $ ;

Another tricky one. Get the length of a string, compile a jump to the address that would follow the string, and inline it after the jump.

4 elements #value num negate? flag 10 variable: base label: numbers "0123456789ABCDEF" $,

These are used in parsing (and later, in display) of numbers. The "base" holds the current numeric base, and "numbers" is a string of characters that are valid for parsing as numbers.

5.16.5 DONE def `atib`, `\quot`

w: atib atib memory # @, STRING-LENGTH 2 # * - ;
"(  -a ) Returns address of alternate text input buffer" :doc

w: " t-" ' atib # ' tib # :is '" # accept ' tib # :devector atib ;
"( ``-$ ) temporary function to create strings until __`` is defined" :doc

5.16.6 TODO :devector and :is `{ move these! }`

w: :devector :devector ( a-  ) 0 # swap, !+ 0 # swap !, ;
"( a- ) Restore a function to its original state" :doc

w: :is :is      ( aa- ) 8 # swap, !+ !, ;
"( aa- ) Alter a function to point to a new function" :doc

5.17 TODO Number Parsing & Display `{what happened to the display?}`

5.17.1 | number related variables

4 elements #value num negate? flag

10 variable: base

label: numbers "0123456789ABCDEF" $,

5.17.2 DEF `nums`

w: numbers nums     ( -a ) numbers # ;
"(  -a ) Function returning address of string containing all valid numeric characters" :doc

Return the "numbers" string. This an be revectored to allow for adding more bases later.

5.17.3 | number parsing and display

{ @base digits valid? digit? toDigit isNegative convert } internal

i: @base    ( -n ) base # @, ;
( [ -n ] helper function, returns value stored in **base** )

i: (digits) nums +, @, over =if num # on then ;
( NEEDS-DESCRIPTION )

i: digits   1-, repeat dup, push, (digits) pop, 0; 1-, again ;
( NEEDS-DESCRIPTION )

i: valid?   @base dup, 16 # <if digits ; then drop, ;
( NEEDS-DESCRIPTION )

i: digit?   num # off valid? drop, num # @, ;
( NEEDS-DESCRIPTION )

i: toDigit  ( c-n ) '0 # -, @base 16 # =if dup, 16 # >if 7 # -, then then ;
( NEEDS-DESCRIPTION )

Various helpers.

{ isNegative? } internal
```
i: isNegative? ( a-a )
   dup, @, '- # =if negate? # on 1+, ; then 1 # negate? # !, ;
( NEEDS-DESCRIPTION )
```
If a number is negative, set the "negate?" variable to -1, otherwise set it to 1. After conversion, we multiply by this to change the sign as needed.

5.17.4 DEF toNumber

i: (convert)
   repeat
     dup, @, 0; toDigit #value # @, @base *, +, #value # !, 1+,
   again ;
( NEEDS-DESCRIPTION )

w: toNumber toNumber ( $-n )
   isNegative? 0 # #value # !, (convert) drop, #value # @, negate? # @, *, ;
"( $-n ) Convert a string to a number" :doc

t: toNumber ( $-n )

isNegative? #0 #value # !, (convert) drop, #value # @, negate? # @, *, ;

Convert a string to a number.

5.17.5 DEF isNumber?

i: (isnumber)
   repeat dup, @, 0; digit? flag # @, and, flag # !, 1+, again ;
( NEEDS-DESCRIPTION )

w: isNumber? isNumber? ( $-f ) isNegative? flag # on (isnumber) drop, flag # @, ;
"( $-f ) See if a string is a valid number in the current **base**" :doc

Check to see if a string is a valid number.

6 elements memory fb fw fh cw ch

Variables that hold information about the memory size and displays(s) being provided.

5.18 TODO Startup : `boot` .. `run-on-boot`

w: boot boot         (  -  )
   copytag # puts 32 # putc version # puts cr ;
"( - ) Called when the image first loads; use for custom startup routines" :doc

i: query        ( n-n ) 5 # out, wait 5 # in, ;
( NEEDS-DESCRIPTION )

i: run-on-boot  (  -  )
   -1  # query memory # !,  ( Memory Size     )
   -2  # query fb #     !,  ( Canvas Present? )
   -3  # query fw #     !,  ( Canvas Width    )
   -4  # query fh #     !,  ( Canvas Height   )
   -11 # query cw #     !,  ( Console Width   )
   -12 # query ch #     !,  ( Console Height  )
   boot ;
( NEEDS-DESCRIPTION )

5.18.1 | startup

t: boot ( - )

copytag # puts #32 putc version # puts

#32 putc #40 putc build # puts #41 putc cr ;

This is called on startup. By default it displays a little info about Retro, but can be revectored to do other tasks.
t: query ( n-n ) #5 out, wait, #5 in, ;
t: run-on-boot ( - )
#-1 query memory # !, ( Memory Size )

#-2 query fb # !, ( Canvas Present? )

#-3 query fw # !, ( Canvas Width )

#-4 query fh # !, ( Canvas Height )

#-11 query cw # !, ( Console Width )

#-12 query ch # !, ( Console Height ) boot ;

Each time the VM starts, this requeries the VM to update the variables. It is not exposed to the dictionary.

Now we move on to searching the dictionary. This is pretty simple:
1. take the most recent entry, see if the name field matches the string provided
2. if so, set "which" to the dictionary header start, and return the header and a true flag
3. If not found, get the next header and repeat
4. If not found at all, return a bogus pointer and a false flag
  2 elements name found
Variables used by the searching, other than "which".

5.19 DONE Dictionary Search

5.19.1 { helpers for `find` }

2 elements name found

i: prepare  ( a-a  ) found # off name # !, last # @, ;
( NEEDS-DESCRIPTION )

This resets the variables.

i: done     (  -af ) which # @, found # @, ;
( NEEDS-DESCRIPTION )

This returns a pointer to a header and the flag.

i: match?   ( $-$f ) dup, d->name name # @, compare ;
( NEEDS-DESCRIPTION )

Compare the requested string with the name field of a header.

i: <search> ( $-   )
   repeat match? 0 # !if which # !, found # on ; then @ 0; again ;
( NEEDS-DESCRIPTION )

Loop through, looking for a match.

5.19.2 DEF `find`

w: find find     ( $-af ) prepare <search> done ;
"( $-af ) Search for a name in the dictionary. Returns  a dictionary header and a flag" :doc

Wrap it all up. This is exposed to the dictionary.

5.19.3 DEF ='=

w: ' t-'      ( "-a  ) 32 # accept tib find 0 # !if d->xt @, ; then drop, 0 # ;
"( ``-a ) Interpret time: return the address ('xt') of a name" :doc

Read a name from the input, and return either a zero, or the contents of the xt field that corresponds to the name. This is exposed as ' in the dictionary.

5.20 `[1/4]` Word Prefixes and "Not Found"

5.20.1 Now to the word prefixes…

label: _ "_" $,

This sets up a small string providing a template for the prefix names. In Retro, all prefixes are named with two leading underscores. This template will be modified by the remaining prefix code.

5.20.2 TODO DEF get internal

label: ___   "___" $,
i: get      ( $-$  ) dup, @, ___ # 2 # +, !, 1+, ;
( NEEDS-DESCRIPTION )

Given a string, take the first character, modify the prefix template, and return the string sans the first character.

5.20.3 TODO DEF xt:class internal

i: xt:class ( d-aa ) dup, d->xt @, swap, d->class @, ;
( NEEDS-DESCRIPTION )

Given a dictionary header, return an xt and class.

5.20.4 TODO DEF try internal

i: try      (  -   )
   tib get find 0 #
   !if d->xt @, ___ # find
      0 # !if xt:class withClass 0 # ; then drop,
   then drop, -1 # ;
( NEEDS-DESCRIPTION )

See if the token starts with a prefix. If so, invoke the prefix and return 0. If not, return -1.

5.20.5 DONE DEF `notFound`

w: <notFound> <notFound> ( -f ) tib getLength 2 # >if try then ;
"( -f ) Called by **notFound**; hook for custom error handling. Used by the prefix system. Returns  a flag of 0 if the error is cleared, or -1 if not " :doc

w: notFound notFound   ( -  ) <notFound> 0; drop, cr tib puts 32 # putc '? # putc cr ;
"( - ) Called when a name is not found. Calls **<notFound>** and displays an error message  if necessary" :doc

These are called when a token is not found in the dictionary. They display an error message. Also, they invoke the prefix handlers first. Later the <notFound> portion is extended to allow for an additional type of prefix: parsing prefixes.

5.21 `[5/5]` Listener

Now on to the listener itself…

5.21.1 DONE DEF `ok`

w: ok ok      (   - ) compiler # @, not 0; drop, cr okmsg # puts ;
"( - ) Displays the ``ok`` prompt" :doc

If the compiler is off, this displays the prompt in okmsg. This procedure can be revectored later if you want different behavior.

5.21.2 DONE DEF `build#` internal

i: build#  (   - ) tib toNumber ' .data # jump: withClass
( NEEDS-DESCRIPTION )

Convert the string in TIB to a number, then invoke the .data class via withClass.

5.21.3 DONE DEF `number` internal

i: number  (   - ) tib isNumber? 0 # !if jump: build# then jump: notFound
( NEEDS-DESCRIPTION )

Check the string in TIB. If it's a number, then build#, otherwise run 5.20.5.

5.21.4 DONE DEF `process` internal

i: process ( af- ) 0 # !if xt:class jump: withClass then drop jump: number
( NEEDS-DESCRIPTION )

If a string in TIB corresponds to a known word, fetch its class, and execute it via withClass. Otherwise, execute number.

5.21.5 DONE DEF `listen`

w: listen listen  (   - ) repeat ok 32 # accept tib find process again ;
   "( - ) Top level interpreter. Reads and process input." :doc

The listener itself. Display the prompt, read a whitespace delimited token, search the dictionary for it, and call "process" to handle it. Then repeat, forever. (Or until "bye" is called)

5.22 `[0/4]` Extra documentation for the initial dictionary.

5.22.1 TODO <try and regroup these things, just for the documentation here> mjw

I think these are variables declared early on in the process, before the dictionary structure is set up and working. Not 100% sure. Perhaps they can be moved inline?

5.22.2 TODO <ungrouped>

last         data: last
"( -a ) Variable; pointer to most recent dictionary  header" :doc

compiler     data: compiler
"( -a ) Variable; holds compiler state" :doc

fb           data: fb
"( -a ) Variable; Is canvas present?" :doc

fw           data: fw
"( -a ) Variable; Framebuffer width" :doc

fh           data: fh
"( -a ) Variable; Framebuffer height" :doc

memory       data: memory
"( -a ) Variable; Holds amount of memory provided by the VM" :doc

cw           data: cw
"( -a ) Variable; Console width" :doc

ch           data: ch
"( -a ) Variable; Console height" :doc

heap         data: heap
"( -a ) Variable; Pointer to current free location in heap" :doc

which        data: which
"( -a ) Variable; Holds pointer to most recently looked up header" :doc

remapping    data: remapping
"( -a ) Variable; indicates whether CR, LF, and TAB should be treated as whitespace" :doc

eatLeading?  data: eatLeading?
"( -a ) Variable; indicates whether **accept** should ignore leading delimiters" :doc

base         data: base
"( -a ) Variable; holds current base for numeric conversion and display" :doc

update       data: update
"( -a ) Variable; flag indicating whether or not **redraw** should update the display" :doc

5.22.3 TODO `version` , `build`

version      data: version
"( -$ ) String holding version information" :doc

build        data: build
"( -$ ) String holding a build identifier" :doc

5.22.4 TODO `vector` `tabAsWhitespace` settings

vector       data: vector
"( -a ) Variable; compile function as a vector" :doc

tabAsWhitespace data: tabAsWhitespace
"( -a ) Variable; treat tab as whitespace?" :doc

5.23 DONE Finish Metacompiled Part

Well, that's done. Not too hard, thanks to the dictionary building stuff from the metacompiler. When the new image is started by "bootNew", the list above is all that you have access to. Complete enough to allow for a lot to be done, but still small enough to be easily managed.

patch

This seals off the initial dictionary. It updates the variable flagged by mark (which becomes last) to point to the final entry created, leaving us with a useable dictionary.

main: run-on-boot jump: listen

The last actual bit of code in stage 2: the main entry point. This calles run-on-boot to update the memory and display variables, and then jumps to the listener.

endKernel shrink bootNew

Display some statistics on the new kernel for diagnostic purposes.

bootNew will copy the target memory over the old image, and then jump to it. Once bootNew is called, there is no going back. The old image is replaced by the new one, so be sure to keep a backup handy in case changes break things.

6 `[7/35]` Stage 3: Extend The Language

6.1 `=================`

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Ok, at this point the new image should be in control so we have a normal,   )
( though brutally minimal Retro system from here on.                          )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

: :doc keepString last @ d->doc ! ;
" ( $- ) attach documentation string to latest defined function" :doc

6.2 DONE stack words

As noted by the comment above, at this point we have only the basic set of functions and variables available. We start by defining more stack and variable operations.

( Stack Words ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

: nip   (  xy-y    ) swap drop ;
" ( xy-y ) Drop the NOS from the stack" :doc

: rot   ( xyz-yzx  ) push swap pop swap ;
" ( xyz-yzx ) Rotate the top three values on the stack" :doc

: tuck  (  xy-yxy  ) swap over ;
" ( xy-yxy ) Put a copy of TOS under NOS" :doc

: +!    (  na-     ) dup push @ + pop ! ;
" ( na- ) Add value to value at address" :doc

: -!    (  na-     ) dup push @ swap - pop ! ;
" ( na- ) Subtract value from value at address" :doc

: ++    (   a-     ) 1 swap +! ;
" ( a- ) Increment variable by 1" :doc

: --    (   a-     ) 1 swap -! ;
" ( a- ) Decrement variable by 1" :doc

: ?dup  (   n-n || n-nn )  dup 0; ;
" ( -n ) Duplicate TOS if non-zero. If zero, leave value alone" :doc

6.3 DONE Then the scope functions:

( Scope ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
create list  ( -a )  0 , 0 ,

: {{ ( - )  vector off last @ dup list !+ ! ;
" ( - ) Start a namespace (private portion)" :doc

: ---reveal--- ( - ) vector on last @ list 1+ ! ;
" ( - ) Switch to public portion of a namespace" :doc

: }} ( - )
  vector on list @+ swap @ ==
  [ list @ last ! ]
  [ list @ [ last repeat @ dup @ list 1+ @ != 0; drop again ] do ! ] if ;
" ( - ) Close a namespace, sealing off private symbols" :doc

These are hairy, but basically involve relinking the dictionary chain. The simplest case:

:  foo 1 2 + ;
 {{
   : bar foo foo * ;
 }}

Would leave "foo" visible, and hide "bar". This is pretty easy to do, but the scope control goes a bit further:

:  foo 1 2 + ;
 {{
   : bar foo foo * ;
 ---reveal---
   : big bar putn ;
 }}

Would leave foo and big visible, but hide bar. This is done by locating the header of big, and pointing its link field to the header of foo.

6.4 DONE vectored execution

Retro allows for functions created via the colon compiler to be revectored. This provides support for altering existing functionality at a later time and is done by replacing the two nop's at the start of each colon definition with a jump to the new function.

Devectoring is done by replacing the jump with two nop's.

( Vectored Execution ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

: devector  ( "-  ) ' 0; :devector ;
" ( ``- ) Same as **:devector**, but parses for name of function" :doc

: is        ( a"- ) ' 0; :is ;
" ( a``- ) Same as **:is**, but parses for name of function" :doc

: default:  ( "-  ) ' 2 + , ; ' .macro last @ d->class !
" ( ``- ) Compile call to default definition of a function, ignoring any revectoring" :doc

This compiles a call to a default definition, skipping the possible revectoring. It's useful for extending an existing function.

6.5 TODO { refile these }

: HEADERS   (  -n ) 32 ;
" ( -n ) Returns number of private headers permitted" :doc

{{
  : scratch  ( -a )
    memory @       STRING-LENGTH   -  ( tib     )
                   STRING-LENGTH   -  ( scratch )
    STRING-BUFFERS STRING-LENGTH * -  ( buffers )
    HEADERS dup STRING-LENGTH * swap 3 * + -  ( headers ) ;

  create next  0 ,
  create split 0 ,

  [ split @
    [ heap @ [ next @ heap ! default: header heap @ next ! ] dip heap ! here last @ d->xt ! ]
    [ default: header ] if ] is header

  create z
     999 , 999 , 0 ,

  [ split  on scratch next ! default: {{           z header ] is {{
  [ split off                default: ---reveal---          ] is ---reveal---
  [ split off                default: }}                    ] is }}
}}

6.6 DONE dictionary words

 ( Dictionary ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
  create a 0 , create b 0 , create c 0 , create xt 0 ,
  : skim       ( a-a )
    last repeat @ over over d->xt @ == [ nip 0 ] ifTrue 0; again ;
  : getHeaders ( $-  )
    xt ! 0 a ! 0 b ! 0 c !
    last repeat @ 0; dup d->xt @ xt @ == [ dup b ! @ a ! 0 ] [ -1 ] if 0; drop dup c ! again ;
  : <hide>     ( a-  ) getHeaders b @ 0; drop a @ c @ ! ;
---reveal---

This set of functions is used to access and manipulate the dictionary.

: d'         ( "-a ) ' drop which @ ;
" ( ``-a ) Parse for a name and return the dictionary header corresponding to it" :doc

This acts like ' but returns a dictionary header rather than the contents of the xt field. If you look here, you'll see that it uses ' to do the search, discards the xt, and pulls the actual header address out of "which". #+end_src

: xt->d      ( a-d || a-0 ) dup skim over over == [ - ] [ nip ] if ;
" ( a-d ) Given an address, return the corresponding dictionary header or 0 if not found" :doc

If you have an xt, this will try to find a dictionary header that corresponds to it. If it fails, it'll return a zero.

  : :hide      ( a-  )
    dup xt->d last @ == [ drop last @ @ last ! ] [ <hide> ] if ;
  " ( a- ) Remove a name from a dictionary. Specify the address of a function. Used by **hide**" :doc

  : hide       ( "-  ) ' 0; :hide ;
  " ( ``- ) Remove a name from the dictionary" :doc
}}

These relink the dictionary to hide a single header. You can either provide an xt or parse for a name.

hide list
hide vector

Hide a factor used in the creation of scopes.

6.7 DONE reclass

: reclass      (  a- ) last @ d->class ! ;
" ( a- ) Change class of most recent function to specified class" :doc

: reclass:     ( a"- ) d' d->class ! ;
" ( a``- ) Same as **reclass**, but parse for function to change class of" :doc

6.8 DONE initial prefixes

( Initial Prefixes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
  : xt:class ( a-aa ) dup xt->d 0; d->class @ withClass ;
---reveal---
  : __&  ( a-a ) .data                  ; &.macro reclass
  " ( a-a ) Prefix; returns address of a variable or function" :doc

  : __@  ( a-n ) xt:class &@  xt:class  ; &.macro reclass
  " ( a-n ) Prefix; execute function or data element and fetch from addres returned" :doc

  : __!  ( na- ) xt:class &!  xt:class  ; &.macro reclass
  " ( na- ) Prefix; execute function or data element and store value to address returned" :doc

  : __+  ( na- ) xt:class &+! .word     ; &.macro reclass
  " ( na- ) Prefix; execute function or data element and add value to value at address returned" :doc

  : __-  ( na- ) xt:class &-! .word     ; &.macro reclass
  " ( na- ) Prefix; execute function or data element and subtract value from value at address returned" :doc

  : __2  ( a-  ) &xt:class sip xt:class ; &.macro reclass
  " ( a- ) Prefix; execute function twice" :doc
}}

The initial set of prefixes. Note that we redefine "xt:class" here. It's slightly different than the non-exposed one in the kernel.

&	Return the address (xt) of a named item
@	Fetch a value from a variable
!	Store a value to a variable
+	Add a value to the value stored in a variable
-	Subtract a value from the value stored in a variable
2	Execute a function twice.

At this point we only have basic prefixes; support for parsing prefixes will be created later.

6.9 TODO classes { .primitive was moved to the kernel }

In the kernel, we have three classes: .word, .macro, and .data. Here we define two additionals.

.primitive

This is used for the handful of functions that map to a single Ngaro instruction. If the function is not revectored, and the compiler is active, it will inline the instruction rather than laying down a call. Otherwise, it acts the same as the ".word" class.

.compiler

This provides an alternative to ".macro" for things that are only intended to be used inside a definition. At the interpreter, things with this class are silently ignored.

( Classes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

: .compiler    (  a- ) @compiler &do &drop if ;
" ( a- ) Class for functions that can only be used inside a definition" :doc

: immediate    (   - ) &.macro reclass ;
" ( - ) Set the most recent function to **.macro** class" :doc

: compile-only (  "- ) &.compiler reclass ;
" ( ``- ) Set the most recent function to **.compiler** class" :doc

6.10 TODO remapping

6.10.1 TODO { .primitive again }

Now that we have some new classes, let's change the class of some existing functions to ".primitive" to improve performance:

6.10.2 : p: ( "- ) &.primitive reclass: ;

p: 1+ p: 1- p: swap p: drop p: and p: or p: xor p: @ p: ! p: + p: - p: * p: /mod p: p: dup p : in p: out hide p:

6.10.3 And a couple of things to ".compiler" for safety.:

( Remap some classes for efficiency and safety ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
here
{{
  : c: ( "- ) &.compiler reclass: ;
  c: pop    c: push   c: 0;     c: ;;    c: ;      c: repeat c: again
}}
!heap

6.11 DONE compiler macros

6.11.1 ` (backtick)

Ok, now on to backtick:

( Compiler Macros ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: `     ( "-  )
  ' ?dup 0 != -1 ==
  [ .data @which @d->class , ]
  [  tib isNumber? -1 ==
    [ tib toNumber .data &.data , ] &notFound if ] if ; compile-only
"( ``- ) Either execute a function, or compile the xt  and a call to the corresponding class handler. This will also work with numbers" :doc

This is similar to "postpone", but with a subtle difference. We use it in cases where we wish to create state-aware macros. This is probably best seen with an example.

( A function to inline "1 2 +" into a definition )
:  foo  1 , 1 , 1 , 2 , 16 , ; compile-only

Ouch. Too many magic numbers. We could clean this up with the classes:

( A function to inline "1 2 +" into a definition )
:  foo  1 .data 2 .data &+ .primitive ; compile-only

Longer, but more readable. With backtick we can do this instead:

( A function to inline "1 2 +" into a definition )
:  foo  ` 1 ` 2 ` + ; compile-only

This is identical in functionality to the version using classes, but much more compact and readable.

6.11.2 `jump:`

: jump: ( "- ) ' 0; 8 , , ; compile-only
"( ``- ) Compile a jump to another function" :doc

Compile a jump to a named function.

6.12 TODO ( Additional Combinators `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: []      (    -    ) ` [ ` ] ; immediate
" ( - ) Empty quote" :doc

: while   (   q-    ) [ repeat dup dip swap 0; drop again ] do drop ;
" ( q- ) Execute quote until quote returns a flag of" :doc

: until   (   q-    ) [ repeat dup dip swap not 0; drop again ] do drop ;
" ( q- ) Execute quote until quote returns a flag of -1" :doc

: curry   (  nq-q   ) [ [ ` [ ] dip .data ] dip , ` ] ;
" ( nq-q ) 5 [ . ]   =  [ 5 [ . ] do ]" :doc

: take    (  qq-q   ) swap [ [ ` [ ] dip , ] dip .data ` ] ;
" ( qq-q ) 5 [ . ]   =  [ [ . ] do 5 ]" :doc

: bi      (  xqq-   ) &sip dip do ;
" (  xqq- ) Apply each quote to a copy of x" :doc

: bi*     ( xyqq-   ) &dip dip do ;
" ( xyqq- ) Apply q1 to x and q2 to y" :doc

: bi@     (  xyq-   ) dup bi* ;
" (  xyq- ) Apply q to x and y" :doc

: tri     ( xqqq-   ) [ &sip dip sip ] dip do ;
" ( xqqq- ) Apply each quote to a copy of x" :doc

: tri*    ( xyzqqq- ) [ [ swap &dip dip ] 2dip ] dip do ;
" ( xyzqqq- ) Apply q1 to x, q2 to y, and q3 to z" :doc

: tri@    ( xyzq-   ) 2dup tri* ;
" ( xyzq- ) Apply q to x, y, and z" :doc

: cons    (  ab-q   ) 2push ` [ 2pop &.data bi@ ` ] ;
" ( ab-q ) Create a quote returning two data elements" :doc

6.13 TODO preserve stack comment looks wrong here.

: preserve ( aq-    ) swap &@ sip [ &do dip ] dip ! ;
" ( aq- ) Given a variable (a) and a quote (q), preserve the contents of (a) while executing  the quote, and restore the original contents  of (a) after execution completes. (a) is removed from the stack before (q) is executed." :doc

: when    (  nqq-n  )
  [ over swap do ] dip swap
  [ do -1 ] [ drop 0 ] if 0; pop 2drop ;
" ( nqq-n ) Execute q1, with a copy of n on the stack.\n\nIf q1 returns a true flag, run q2 and exit the caller.\n\nIf not, discard q2 and return to the  caller.\n\nq2 is permitted to discard n, which will alter the stack effect." :doc

: whend   ( nqq-? )
  [ over swap do ] dip swap
  [ nip do -1 ] [ drop 0 ] if 0; pop 2drop ;
" ( nqq-? ) Execute q1, with a copy of n on the stack.\n\nIf q1 returns a true flag, drop n, run q2 and exit the caller.\n\nIf not, discard q2 and return to the caller. " :doc

{{
  : for   ( R: n-  C: -a ) here ` push ; compile-only
  : next  ( R: -   C: a- ) ` pop 7 , , ; compile-only
  : i 2pop pop 2over 2push swap - swap push ;
  : tors  (    -n ) ` pop ` dup ` push ; compile-only
---reveal---
  : times (  nq-  )
    over 1 >= [ swap for dup dip next drop ] [ 2drop ] if ;
  " ( nq- ) Run quote (n) times" :doc

  : iterd (  nq-  )
    over 1 >= [ swap for tors swap dup dip next drop ] [ 2drop ] if ;
  " ( nq- ) Run quote (n) times and push counter to stack each time. Counts down." :doc

  : iter  (  nq-  )
    over 1 >= [ swap dup push for i swap dup dip next pop 2drop ] [ 2drop ] if ;
  " ( nq- ) Run quote (n) times and push counter to stack each time. Counts up." :doc
}}

{{
  : each   (  qa- ) [ [ swap dup &do dip ] sip 1+ ] times 2drop ;
  : array  (  aq- ) swap @+ dup 1 > [ each ] [ 2drop ] if ;
  : buffer ( anq- ) 2rot each ;
  : list   (  lq- ) [ &@ dip 2over [ &do dip ] dip over @ ] while 2drop ;
---reveal---
  : <each@> ( ...t- ) drop ;
  " ( ...t- ) Hook into **each@** for adding additional types" :doc

  : each@   ( ...t- )
    [ 0  ( ARRAY  ) == ] &array                     whend
    [ 1  ( BUFFER ) == ] &buffer                    whend
    [ 2  ( STRING ) == ] [ &withLength dip buffer ] whend
    [ 3  ( LIST   ) == ] &list                      whend
    <each@> ;
  " ( ...t- ) Supercombinator for applying a quote to each item in various data structures.\nProvide one of the following stack forms:\n\n    ARRAY:  aq-\n    BUFFER: anq-\n    STRING: $q-\n    LIST: lq-\n\nFor LIST, *l* should be a variable pointing to the list.\n\nThe quote will be given the address of the current element with each time it is invoked by each@." :doc
}}

6.13.1 TODO | Now for more combinators.

: [] ( - ) ` [ ` ] ; immediate

Create an empty quote.
: while ( q- ) [ repeat dup dip swap 0; drop again ] do drop ;

Execute quote until quote returns a flag of 0
: curry ( nq-q ) [ [ ` [ ] dip .data ] dip , ` ] ;

Bind data and an action into a new quote. E.g., the following forms are identical in functionality:

5 [ putn ] curry [ 5 [ putn ] do ]
: take ( qq-q ) swap [ [ ` [ ] dip , ] dip .data ` ] ;

Bind data and an action into a new quote. This is dlightly different than "curry" in that these forms are identical:

5 [ putn ] curry [ [ putn ] do 5 ]
: bi ( xqq- ) &sip dip do ;

Apply each quote to a copy of x
: bi* ( xyqq- ) &dip dip do ;

Apply q1 to x and q2 to y
: bi@ ( xyq- ) dup bi* ;

Apply q to x and y
: tri ( xqqq- ) [ &sip dip sip ] dip do ;

Apply each quote to a copy of x
: tri* ( xyzqqq- ) [ [ swap &dip dip ] dip dip ] dip do ;

Apply q1 to x, q2 to y, and q3 to z
: tri@ ( xyzq- ) 2dup tri* ;

Apply q to x, y, and z
: cons ( ab-q ) 2push ` [ 2pop &.data bi@ ` ] ;

Create a quote returning two data elements. These forms are identical:

1 2 cons [ 1 2 ]
: preserve ( aq- ) swap [ @ ] sip [ [ do ] dip ] dip ! ;

Given a variable (a) and a quote (q), preserve the contents of (a) while executing the quote, and restore the original contents of (a) after execution completes.

(a) is removed from the stack before (q) is executed.

We'll see this in use later.
: when ( nqq-n )
[ over swap do ] dip swap [ do -1 ] [ drop 0 ] if 0; pop 2drop ;

Execute q1, with a copy of n on the stack. If q1 returns a true flag, run q2 and exit caller. If not, discard q2 and return to caller. q2 is permitted to discard n, which will alter the stack effect.

{{
```
for   ( R: n-  C: -a ) here ` push ; compile-only
next  ( R: -   C: a- ) ` pop 7 , , ; compile-only
i 2pop pop 2over 2push swap - swap push ;
tors  (    -n ) ` pop ` dup ` push ; compile-only
```
Internal factors used to build the next three combinators.

—reveal—
```
times (  nq-  )
```
over 1 >= [ swap for dup dip next drop ] [ 2drop ] if ;

The "times" combinator runs a quote (n) times
```
iterd (  nq-  )
```
over 1 >= [ swap for tors swap dup dip next drop ] [ 2drop ] if ;

The "iterd" combinartor runs a quote (n) times and push counter to stack each time. Counts down.
```
iter  (  nq-  )
```
over 1 >= [ swap dup push for i swap dup dip next pop 2drop ] [ 2drop ] if ;

The "iter" combinator runs a quote (n) times and push counter to stack each time. Counts up.

}}
each@
And now onto "each@". This one is a complex combinator, in that it has differing stack effects based on the data types being passed to it. First the code:

{{
```
<each> (  qa- ) [ dup [ swap dup &do dip ] dip 1+ ] times 2drop ;
array  (  aq- ) swap @+ dup 1 > [ <each> ] [ 2drop ] if ;
buffer ( anq- ) 2rot <each> ;
list   (  lq- ) [ &@ dip 2over [ [ do ] dip ] dip over @ ] while 2drop ;
```
—reveal—
```
<each@> ( ...t- ) drop ;
each@   ( ...t- )
```
[ 0 ( ARRAY ) = ] [ drop array ] when [ 1 ( BUFFER ) = ] [ drop buffer ] when [ 2 ( STRING ) = ] [ drop &withLength dip buffer ] when [ 3 ( LIST ) = ] [ drop list ] when <each@> ; }}

And the notes from the documentation:

<each@> ( …t- ) Hook into each@ for adding additional types each@ ( …t- ) Supercombinator for applying quote to each item in various data structures. Also provide on the stack:

ARRAY: aq- BUFFER: anq- STRING: $q- LIST: lq-

The quote is given the address of the current element each time it is invoked.

We'll see this in use later.

6.14 TODO ( Memory Blocks `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: copy   ( aan-  ) [ &@+ dip !+ ] times 2drop ;
" ( aan- ) Copy n values from source (a1) to dest (a2)" :doc

: fill   ( ann-  ) swap !here [ @here swap !+ ] times drop ;
" ( ann- ) Fill (n2) memory locations starting at (a) with value (n1)" :doc

6.14.1 TODO | memory blocks

: copy ( aan- ) [ &@+ dip !+ ] times 2drop ;

This is used to copy a block of memory from one location to another. It is not intended for moving blocks backwards, and overlaps may be troublesome.
: fill ( ann- ) swap !here [ @here swap !+ ] times drop ;

Fill a block of memory with a value. We use "here" to hold this value.

6.15 TODO ( Conditionals `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: ahead  (   -a  ) 8 , here 0 , ;
" ( -a ) Used in conditionals; compiles a branch to be patched in later" :doc

: if;    (  f-   ) ` not ` 0; ` drop ; compile-only
" ( f- ) Exit function if TOS is a non-zero flag" :doc

: within ( xlu-f ) &over dip <= &>= dip and ;
" ( xlu-f ) Is (x) within lower (l) and upper (u) bounds?" :doc

6.15.1 TODO | conditionals

: ahead ( -a ) 8 , here 0 , ;

Compile a branch to 0, leaving a pointer to the branch target that we can set later.
: if; ( f- ) ` not ` 0; ` drop ; compile-only

Exits a function if TOS is not zero. Useful in unconditional loops.
: within ( xlu-f ) &over dip <= &>= dip and ;

Attempt to see if a value is within lower and upper bounds. This is inclusive. E.g.,

1 1 3 within

Would return true, as the upper and lower bounds are included in the set checked.

6.16 TODO ( Data Structures `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: variable:  ( n"-  ) create , ;
" ( n``- ) Create a new variable with an initial value " :doc

: variable   (  "-  ) 0 variable: ;
" ( ``- ) Create a new variable with an initial value of 0" :doc

: constant   ( n"-  ) create @last !d->xt ;
" ( n``- ) Create a numeric constant" :doc

: string:    ( $"-  ) keepString constant ;
" ( $``- ) Create a string constant" :doc

: allot      (  n-  ) dup 0 < [ +heap ] [ [ 0 , ] times ] if ;
" ( n- ) Allocate space in the heap" :doc

{{
  : list     (  n-a ) here swap allot ;
  : element  (  a-a ) create dup @last !d->xt 1+ ;
---reveal---
  : elements ( n"-  ) dup list swap &element times drop ;
  " ( n``- ) Create a series of variables" :doc
}}

6.16.1 data structures

: variable: ( n"- ) create , ;
: variable ( "- ) 0 variable: ;

Variables are created using these. The first form takes an initial value from the stack; the second initializes the variable to zero.
: constant ( n"- ) create @last !d->xt ;

Here we abuse the classes to create constants. We alter the xt field to hold the value of the constant, and let ".data" take care of the details. Trying to execute a constant is not possible.
: allot ( n- ) dup 0 < [ +heap ] [ repeat 0; 1- 0 , again ] if ;
Allocate (or free) space in the heap. Pass a negative value to free, or a positive one to allocate space. This will zero out memory when allocating, but not when freeing.

TIP:

If you don't need the zeroing out, you can save space by doing:
```
allot ( n- ) +heap ;
```
Instead.

Now for a beautiful thing from Like (docl in #retro):

{{
```
list     (  n-a ) here swap allot ;
element  (  a-a ) create dup @last !d->xt 1+ ;
```
—reveal—
```
elements ( n"-  ) dup list swap &element times drop ;
```
}}

Elements are like a series of variables, but with an important twist: the data is sequential in memory, not broken up by the headers. So the following can be done to create a simple array with named items:

3 elements A B C 100 200 300 A !+ !+ !+ drop A @+ putn @+ putn @+ putn drop

As can be seen, this can be useful if you need easy access to an array of data.

6.17 TODO ( Numbers and Math `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: decimal ( - ) 10 !base ;
" ( - ) Switch **base** to 10" :doc

: hex     ( - ) 16 !base ;
" ( - ) Switch **base** to 16" :doc

: octal   ( - )  8 !base ;
" ( - ) Switch **base** to  8" :doc

: binary  ( - )  2 !base ;
" ( - ) Switch **base** to  2" :doc

6.17.1 numeric bases

: decimal ( - ) 10 !base ;
: hex ( - ) 16 !base ;
: octal ( - ) 8 !base ;
: binary ( - ) 2 !base ;

Change the current base. Nothing fancy here.
toString
{{ create buf 32 allot 2 elements digits pos
```
split    (   n-... )
```
repeat @base /mod swap numbers + @ swap digits ++ 0; again ;
```
build    ( ...-    )
```
buf @pos [ @pos swap !+ ] ifTrue @digits [ !+ ] times 0 swap ! ;
```
negate?  (   n-n   ) dup 0 >= if; negate 45 !pos ;
```
—reveal—
```
toString (   n-$   ) 0 [ !pos ] [ !digits ] bi negate? split build buf ;
```
}}

Convert a number into a string. This uses "numbers" from the kernel.

6.18 TODO ( Output `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

{{
  create buf   32 allot
  2 elements digits pos
  : split    (   n-... )
    repeat @base /mod swap numbers + @ swap digits ++ 0; again ;
  : build    ( ...-    )
    buf @pos [ @pos swap !+ ] ifTrue
    @digits [ !+ ] times 0 swap ! ;
  : negate?  (   n-n   ) dup 0 >= if; negate 45 !pos ;
---reveal---
  : toString (   n-$   ) 0 [ !pos ] [ !digits ] bi negate? split build buf ;
  " ( n-$ ) Convert a number into a string" :doc
}}

: clear (  - ) -1 putc ;
" ( - ) Clear the display" :doc

: space (  - ) 32 putc ;
" ( - ) Display a space character (ASCII 32)" :doc

: putn  ( n- ) toString puts ;
" ( n- ) Display a number" :doc

6.18.1 TODO | output

: clear ( - ) -1 putc ;

Clear the display.
: space ( - ) 32 putc ;

Display a space character.
: putn ( n- ) toString puts ;

Display a number. This does not add a trailing space.

6.19 TODO ( Parsing prefixes `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: .parse  (  a- ) do ;
" ( a- ) Class for parsing prefixes" :doc

: parsing (   - ) &.parse reclass ;
" ( - ) Set most recent function to **.parse** class" :doc

{{
  : number ( a- ) base [ do toNumber .data ] preserve ;
---reveal---
  : __$   ( $-n ) &hex     number ; parsing
  " ( $-n ) Prefix; treat number as hexadecimal (base" :doc

  : __#   ( $-n ) &decimal number ; parsing
  " ( $-n ) Prefix; treat number as decimal (base 10)" :doc

  : __%   ( $-n ) &binary  number ; parsing
  " ( $-n ) Prefix; treat number as binary (base 2)" :doc

  : __'   ( $-n ) @ .data         ; parsing
  " ( $-n ) Return character following '" :doc
}}

6.19.1 TODO | prefix parsing

With this covered, the code moves on to replace the simple prefix handler with one aware of Luke's parsing prefixes:

{{ 4 elements xt class name flag create _ 95 , 95 , 95 , 0 ,

( Split Token into Prefix and Name ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

action   (  -   ) @xt @class withClass ;
(split   (  -a  ) @+ ___ tuck 1+ 1+ ! swap !name ;
prefix)  ( $-f  )

find [ [ @d->class !class ] [ @d->xt !xt ] bi -1 ] [ 0 ] if ;

( Prefix Handling ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

handle   (  -   )

@class &.parse = [ flag off @name action ] [ @name find [ @d->xt action flag off ] [ drop ] if ] if ;

( Main Wrapper ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

try      (  -   )

flag on tib (split prefix) [ handle ] [ drop ] if @flag ; &try is <notFound> }}

The main difference here is that we check to see if the class is ".parse", and act differently if it is. So once this is done, we get to define string parsing.

{{

buffers ( -a ) 2048 here + ;

variable next —reveal—

tempString ( $-$ )

withLength 1+ @next 12 =if 0 !next then @next 512 * buffers + [ swap copy ] sip next ++ ; }}

First up, a rotating string buffer for holding temporary strings. We place these at 2k above here, so it's a floating buffer, and allocate 512 chars per string. Up to 12 can be created, after which, this cycles back, with newer strings replacing older ones.

{{ variable end

pad     (  -a ) 1024 here + ;
keep    (  -  ) @compiler &keepString &tempString if .data ;
>pad    ( $-$ ) pad over getLength 1+ copy pad keep ;
chop    ( $-$ ) end -- 0 @end ! ;
>$      ( n-  ) dup 8 = [ chop drop ] [ @end !+ !end ] if ;
end?    ( $-$ ) @end @1- '" = [ chop >pad -1 ] [ 0 ] if ;
noEat   ( q-  ) eatLeading? off do eatLeading? on ;
withPad ( q-  ) 32 pad 1- ! &pad &tib :is noEat &tib :devector ;
get     (  -c ) getc dup putc ;

—reveal—

__"  ( "-a )

dup withLength + !end end? [ 32 >$ [ end? [ 0 ] [ get >$ -1 ] if ] while ] ifFalse ; parsing

"    ( "-$ ) [ '" accept pad 1- keep ] withPad ; immediate

}}

All of this to get two functions.

__"

Our new parsing prefix. This will let us create strings in a more natural feeling manner:

"hello, world!"

For strings with leading spaces, we have:

Which is used like:

" <– 3 spaces"

The actual mechanics are a bit tricky, but it works quite well in practice.

Next up: a more flexible output function.

-1 variable: formatted

This is a variable controlling whether to use the complex output or the default, simpler output.

6.19.2 TODO | prefix parsing

: .parse ( a- ) do ;

: parsing ( - ) &.parse reclass ;

{{

number ( a- ) base [ do toNumber .data ] preserve ;

—reveal—

__$   ( $-n ) &hex     number ; parsing
__#   ( $-n ) &decimal number ; parsing
__%   ( $-n ) &binary  number ; parsing
__'   ( $-n ) @ .data         ; parsing

}}

Parsing prefixes from Luke. These aren't functional yet, but will a little later in the source.

$	Parse a number as hexadecimal
#	Parse a number as decimal
%	Parse a number as binary
'	Parse and return first character

Notice that the "number" code uses "preserve" to save and restore the "base" for us.

6.20 TODO ( Chained Vocabularies `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

6.20.1 dicts

create dicts 64 allot
" ( -a ) Array; used by chained vocabularies and search order code" :doc

{{
  2 elements active prior
  create "|" 124 ,  0 ,
  create "%%" 37 , 37 , 0 ,
  : seal   (  - ) last [ @ 0; @active over @ == ] until 0 swap ! ;
  : revert (  - ) @prior 0; !last 0 !prior ;
  : safety (  - ) "%%" header immediate &revert @last !d->xt ;
---reveal---
  : %%     (  - ) revert ;
  " ( - ) Close a vocabulary. Use with caution" :doc

  : <%>    ( a- ) @last !prior !last ;
  " ( a- ) Open a vocabulary. Use with caution" :doc

  : .chain ( a- ) @dicts &drop &<%> if ;
  " ( a- ) Class for vocabularies" :doc

  : chain: ( "- ) create 0 , &.chain reclass @last !active safety ;
  " ( ``- ) Create a new vocabulary" :doc

  : ;chain (  - ) seal @last @active [ !last ] [ !d->xt ] bi ;
  " ( - ) End a vocabulary" :doc

  : :with  ( a- ) 0; @dicts 1+ dicts + ! dicts ++ ;
  " ( a- ) Add a vocabulary to the search order (by pointer)" :doc

  : with   ( "- ) ' :with ;
  " ( ``- ) Add a vocabulary to the search order (parses for name)" :doc

  : without ( - ) @dicts 0; 1- !dicts ;
  " ( - ) Remove a vocabulary from the search order " :doc

  : global  ( - ) 0 !dicts ;
  " ( - ) Remove all vocabularies from the search order, leaving just the global dictionary " :doc

  : findInChain ( $a-df ) :with find without ;
  " ( $a-df ) Open a chain (using **:with**) and search for a name. Closes the chain when done." :doc

  : with|  ( "- )
    global
    repeat
      32 accept tib "|" compare if;
      tib find [ @d->xt :with ] &drop if
    again ;
  " ( ``- ) Open a series of vocabularies, ending when ``  is encountered" :doc
}}

: rename: ( a"- )
  create dup xt->d swap :hide
  [ @d->xt @last !d->xt ] [ @d->class @last !d->class ] bi ;
" ( a``- ) Rename a function" :doc

6.20.2 TODO | vocabularies

And now for vocabularies. This is where things get trickier.

create dicts 64 allot

We allow up to 64 active vocabularies. This could be reduced to save space.

{{ 2 elements active prior create "|" 124 , 0 , create "%%" 37 , 37 , 0 ,

Some variables and string constants. We don't have a string parser yet, so have to build the strings manually.
: seal ( - ) last repeat @ 0; @active over @ =if 0 swap ! ;; then again ;

Close off a vocabulary.
: revert ( - ) @prior 0; !last 0 !prior ;

Revert to the prior vocabulary.
: safety ( - ) "%%" header immediate &revert @last !d->xt ;

Create an initial word in every vocabulary named "%%" that will revert us to the prior (hopefully global) vocabulary. This gives us a saftey net to help recover from mistakes…

—reveal—

The above stuff is hidden away from the global dictionary…
: %% ( - ) revert ;

Top-level version of "%%".
: <%> ( a- ) @last !prior !last ;

Save the current vocabulary, and open a new one. This does not nest.
: .chain ( a- ) @dicts &drop &<%> if ;

The class for handling vocabularies. You shouldn't need to use this directly.
: chain: ( "- ) create 0 , &.chain reclass @last !active safety ;

Create a new vocabulary. This is not nestable. The global dictionary is still visible when a new vocabulary is created, so you can still access everything defined prior to this.
: ;chain ( - ) seal @last @active [ !last ] [ !d->xt ] bi ;

Close off a vocabulary, hiding its contents from the global dictionary.
: :with ( a- ) 0; @dicts 1+ dicts + ! dicts ++ ;

Given an xt of a vocabulary, add it to the search order.
: with ( "- ) ' :with ;

Parse for a vocabulary name and add it to the search order.
: without ( - ) @dicts 0; 1- !dicts ;

Remove the most recently added vocabulary from the search order.
: global ( - ) 0 !dicts ;

Remove all vocabularies from the search order.
: findInChain ( $a-df ) :with find without ;

Search for a name in a specific vocabulary. Returns a dictionary header and a flag.
: with| ( "- )

global repeat 32 accept tib "|" compare if; tib find [ @d->xt :with ] &drop if again ;

Add a series of vocabularies to the search order. This stops when a | is encountered.

}}
: rename: ( a"- )
create dup xt->d swap :hide [ @d->xt @last !d->xt ] [ @d->class @last !d->class ] bi ;

Hide a header and create a new one.

With the above, we can create and search in dictionaries. Next we replace the original "find" and "xt->d" functions with new ones that make use of the search order.

{{ 5 elements flag dt name safety xt
```
search  (  -   ) @dicts repeat 0; dup dicts + <%> @xt do 1- again ;
(chains ( $-   ) !name 0 [ !dt ] [ !flag ] bi @last !safety ;
back)   (   -  ) @safety !last ;
seek    ( na-n ) @name default: find [ !dt flag on drop 1 ] [ drop ] if ;
lookup  ( $-af )
```
&seek !xt (chains search back) @flag [ @dt @flag ] [ @name default: find ] if ; &lookup is find
```
seek    (   -  )
```
@name default: xt->d dup [ !dt flag on drop 1 ] [ drop ] if ;
```
lookup  (  a-d )
```
&seek !xt (chains search back) @flag [ @dt ] [ @name default: xt->d ] if ; &lookup is xt->d }}

These use "default:" to fall back into the original definitions as neccessary.

6.21 TODO ( Extend 'find' and 'xt->d' to search chains before global `~~~~~~~~~~~~~~~~` )

{{
  5 elements flag dt name safety xt
  : search  (  -   ) @dicts repeat 0; dup dicts + <%> @xt do 1- again ;
  : (chains ( $-   ) !name 0 [ !dt ] [ !flag ] bi @last !safety ;
  : back)   (   -  ) @safety !last ;
  : seek    ( na-n ) @name default: find [ !dt flag on drop 1 ] &drop if ;
  : lookup  ( $-af )
    &seek !xt (chains search back)
    @flag [ @dt @flag ] [ @name default: find ] if ;
  &lookup is find

  : seek    (   -  )
    @name default: xt->d ?dup [ !dt flag on drop 1 ] ifTrue ;
  : lookup  (  a-d )
    &seek !xt (chains search back)
    @flag [ @dt ] [ @name default: xt->d ] if ;
  &lookup is xt->d
}}

6.22 TODO ( Extend Prefix Handler `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

{{
  4 elements xt class name flag
  create ___ 95 , 95 , 95 , 0 ,

  ( Split Token into Prefix and Name ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  : action   (  -   ) @xt @class withClass ;
  : (split   (  -a  ) @+ ___ tuck 1+ 1+ ! swap !name ;
  : prefix)  ( $-f  )
    find [ [ @d->class !class ] [ @d->xt !xt ] bi -1 ] [ 0 ] if ;

  ( Prefix Handling ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  : handle   (  -   )
    @class &.parse ==
    [ flag off @name action ]
    [ @name find [ @d->xt action flag off ] &drop if ]
    if ;

  ( Main Wrapper ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  : try      (  -   )
    flag on tib (split prefix) &handle &drop if @flag ;
  &try is <notFound>
}}

6.23 TODO ( Core Strings `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

{{
  : buffers  ( -a )
    @memory        STRING-LENGTH   -  ( tib     )
                   STRING-LENGTH   -  ( scratch )
    STRING-BUFFERS STRING-LENGTH * -  ( buffers ) ;
  variable next
---reveal---
  : tempString ( $-$ )
    withLength 1+
    @next STRING-BUFFERS == [ 0 !next ] ifTrue
    @next STRING-LENGTH * buffers + [ swap copy ] sip
    next ++ ;
  " ( a-a ) Move a string to a temporary buffer" :doc
}}

hide "   ( next we define __" and can use proper strings )

{{
  variable end
  : pad  ( -a )
    @memory        STRING-LENGTH   -  ( tib     )
                   STRING-LENGTH   -  ( scratch ) ;
  : keep    (  -  ) @compiler &keepString &tempString if .data ;
  : >pad    ( $-$ ) pad over getLength 1+ copy pad keep ;
  : chop    ( $-$ ) end -- 0 @end ! ;
  : >$      ( n-  ) dup 8 == [ chop drop ] [ @end !+ !end ] if ;
  : end?    ( $-$ ) @end @1- '" == [ chop >pad -1 ] [ 0 ] if ;
  : noEat   ( q-  ) eatLeading? off do eatLeading? on ;
  : withPad ( q-  ) 32 pad 1- ! &pad &tib :is noEat &tib :devector ;
  : get     (  -c ) getc dup putc ;
---reveal---
  : __"  ( "-a )
    dup withLength + !end
    end? [ 32 >$ [ end? [ 0 ] [ get >$ -1 ] if ] while ] ifFalse ; parsing
  "( ``-$ ) Prefix; parse and return a string" :doc

  : "    ( "-$ ) [ '" accept pad 1- keep ] withPad ; immediate
  "( ``-$ ) Parse and return a string" :doc
}}

6.24 TODO ( Formatted String Display `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

-1 variable: formatted
"( -a ) Variable; toggles whether **puts** uses escape sequences or not" :doc

{{
  : withBase ( n$q-$ ) &swap dip base &do preserve ;
  : char ( $-$ )
    @+ [ 'n == ] [ cr      ] whend
       [ '' == ] [ '" putc ] whend
       [ '[ == ] [ 27 putc putc ] when
    putc ;
  : obj  ( $-$ )
    @+ [ 'd == ] [ [ decimal putn ] withBase ] whend
       [ 'o == ] [ [ octal   putn ] withBase ] whend
       [ 'x == ] [ [ hex     putn ] withBase ] whend
       [ 'c == ] [ swap putc                 ] whend
       [ 's == ] [ formatted off &puts dip formatted on ] whend
       putc ;
  : complex ( $-n )
    repeat
      @+ 0;
      dup '\ == [ drop char 0 ] ifTrue
      dup '% == [ drop obj  0 ] ifTrue
      putc
    again ;
  : simple ( $- ) [ @ putc ] 2 ( STRING ) each@ ;
  [ update off @formatted [ complex drop ] &simple if update on redraw ] is <puts>
}}

6.24.1 TODO | formatted strings

number display
{{
```
withBase ( n$q-$ ) [ swap ] dip base [ do ] preserve ;
```
A helper; this saves and restores the base when displaying numbers.
```
char ( $-$ )
```
@+ [ 'n = ] [ drop cr ] when [ '' = ] [ drop '" putc ] when [ '[ = ] [ 27 putc putc ] when putc ;

This is the helper routine for displaying character escape sequences like "\n" and "\'".
```
obj  ( $-$ )
```
@+ [ 'd = ] [ drop [ decimal putn ] withBase ] when [ 'o = ] [ drop [ octal putn ] withBase ] when [ 'x = ] [ drop [ hex putn ] withBase ] when [ 'c = ] [ drop swap putc ] when [ 's = ] [ drop &puts dip ] when putc ;

This is the helper routine for carrying out actions like displaying numbers, characters, or other strings. It handles sequences like: "%s", "%d", and so on.
```
complex ( $-n )
```
repeat @+ 0; dup '\ = [ drop char 0 ] ifTrue dup '% = [ drop obj 0 ] ifTrue putc again ;

Display a string, dispatching escape sequences to either "char" or "obj" as needed.
: simple ( $- ) [ @ putc ] 2 ( STRING ) each@ ;

And here we have an example of that "each@" combinator. This applies a quote ("[ @ putc ]") to each item in a string (data type 2). Really, it's a nice clean way to do things like this.
: defer ( q- ) update off do update on redraw ;

For performance, disable screen updates until the text is written to the output buffers. Won't hurt anything, and makes redraws much faster on some VM implementations.

[ [ @formatted [ complex drop ] &simple if ] defer ] is <puts> }}

And wrap that all up.

6.25 TODO ( Debugging `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

6.25.1 depth

: depth   (    -n ) -5 5 out wait 5 in ;
"( -n ) Return number of items on stack" :doc

Gets the stack depth.

6.25.2 def reset

: reset   ( ...-  ) depth repeat 0; 1- nip again ;
"( ...- ) Remove all items from stack" :doc

Remove all items on the data stack. This is useful after experimenting to get back to clean stack quickly.

6.25.3 def .s

{{
  : (.s)  0; 1- swap push (.s) pop dup putn space ;
---reveal---
  : .s    depth [ "\n<%d> " puts ] sip (.s) ;
  "( - ) Display all items on stack" :doc
}}

6.25.4 def words

{{
  : list    ( a-  ) [ d->name puts space ] 3 ( ^types'LIST ) each@ ;
  : others  (  -  ) @dicts repeat 0; cr dup dicts + list 1- again ;
---reveal---
  : words   (  -  ) cr formatted dup [ off others cr last list ] preserve ;
  "( - ) List all names in dictionary" :doc
}}

Display all names in the dictionary, and any active vocabuaries.

6.26 TODO ( Keymap `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

{{
  : dictionary.find/xt ( string:name - xt )  find [ @d->xt ] [ drop #0 ] if ;

  : prefix?
    dup "keymap:PREFIX" dictionary.find/xt @ == ;

  : seekHandler
    dup "keymap:TABLE"  dictionary.find/xt + @ ;

  [ prefix? [ drop getc:unfiltered seekHandler dup 0 <> [ nip dip cr ] [ 2drop ] if 0 ] ifTrue ] is keymap:handler
}}

6.27 TODO ( Misc. Words `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

: save     (  -  ) 1 4 out wait ;
"( - ) Save the image" :doc

: bye      (  -  ) cr -9 5 out wait ;
"( - ) Exit Retro" :doc

: getToken ( "-$ ) 32 accept tib tempString ;
"( ``-$ ) Read a string, stopping at first whitespace" :doc

: getNumber ( "-n )  getToken toNumber ;
"( ``-n ) Read a number from the input stream" :doc

: :include ( $-  ) 2 4 out wait ;
"( $- ) Include a file" :doc

: include  ( "-  ) getToken :include ;
"( ``- ) Same as **:include**, but parse for file name" :doc

: time     (  -n ) -8 5 out wait 5 in ;
"( -n ) Return the current unix time" :doc

: delay    ( n-  ) time + [ dup time > ] while drop ;
"( n- ) Delay for (approximately) n seconds" :doc

: getEnv   ( a$- ) -10 5 out wait ;
"( a$- ) Get a copy of environment variable $ in buffer" :doc

: later    (  -  ) 2pop swap 2push ;
"( - ) Defer execution of caller until a later time" :doc

{{
  : xt,   ( - ) 1 , @last @d->xt , ;
---reveal---
  : yield ( - ) 1 , here 5 + , xt, ` :is 9 , xt,  ` :devector ; compile-only
  "( - ) Return from a function, with execution resuming from point after **yield** when the  function is next called" :doc
}}

: doc{     ( "-  ) repeat getToken "}doc" compare if; again ;
"( ``- ) Parse tokens up to *}doc* and ignore.\n\nThis is intended as a means of embedding docs into libraries." :doc

: variables|  ( "- )
  repeat getToken "|" compare if; tib header 0 , again ;
"( ``- ) Create a series of variables" :doc

6.27.1 TODO | Just about done…

: reset ( …- ) depth repeat 0; 1- nip again ;
: .s ( - )

depth [ "\n<%d> " puts ] sip 0; heap [ dup [ swap , ] times [ here 1- @ dup putn space -1 allot ] times ] preserve ;

Display the stack. I'd love a better way of doing this, but so far this seems to work ok.
: save ( - ) 1 4 out wait ;

Save the image (if the VM supports it)
: bye ( - ) cr -9 5 out wait ;

Shut down the VM
getToken
: getToken ( "-$ ) 32 accept tib tempString ;

Read a whitespace delimited token, and add it to the temporary string buffer.
include
: :include ( $- ) 2 4 out wait ;
: include ( "- ) getToken :include ;

If you VM supports reading input from files, these will let you include files directly.
: time ( -n ) -8 5 out wait 5 in ;

Returns the current time (or a bogus value) as Unix epoch time.
: delay ( n- ) time + [ dup time > ] while drop ;

If your VM supports the time query, this will allow you to delay execution for approximately the number of seconds specified.
: getEnv ( a$- ) -10 5 out wait ;

If your VM supports access to the host environment, this will let you query it.
later
: later ( - ) 2pop swap 2push ;

A fun thing. Defer execution until the caller returns. For instance,
: a 1 putn later 2 putn ;
: b 3 putn a 4 putn ;

b

With this, the core language is done. If you don't want/need the extra vocabularies, you can save and exit here, or continue on to define what you want.
doc{
: doc{ ( "- ) repeat getToken "}doc" compare if; again ;
This is used to allow embedding of documentation into the source files. An example of its usage:
```
doc{
| **foo**
| This function adds 471 to any variable passed to it.
}doc
:  foo 471 swap +! ;
```
These bits of documenation can be extracted into a separate file later with little effort.

6.28 TODO ( Internal Functions `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

global
chain: internals'
  &quote  create quote  @last !d->xt &.word reclass
  "( -a ) Helper function for quotations" :doc

  &string create string @last !d->xt &.word reclass
  "( -a ) Helper function for strings" :doc
;chain
"( - ) vocabulary containing functions used internally by Retro" :doc

hide string
hide quote

7 `[0/10]` Appendix: Core Libraries

7.1 TODO | Math Operations math

pow  ( bp-n ) 1 swap [ over * ] times nip ;
abs  (  n-n ) dup 0 < &negate ifTrue ;
min  ( ab-c ) 2over < &drop &nip  if ;
max  ( ab-c ) 2over < &nip  &drop if ;

{{ 2 elements w z

7.1.1 : seeds? ( - ) @w @z and ;

7.1.2 : seed ( - ) time [ 62903 and !w ] [ 78578 and !z ] bi ;

7.1.3 : ?seed ( - ) repeat seeds? 0 <> if; seed again ;

7.1.4 : (random) ( -x )

36969 z @ 65535 and * @z 16 >> + !z 18000 w @ 65535 and * @w 16 >> + !w @z 16 << @w + ; —reveal—

7.1.5 : random ( -x ) ?seed (random) abs ;

}}

7.2 TODO ( Generic Buffer `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

global
chain: buffer'
{{
  variables| buffer ptr |
  : terminate (  -  ) 0 @ptr ! ;
---reveal---
  : start     (  -a ) @buffer  ;
  "( -a ) Get starting address of buffer" :doc

  : end       (  -a ) @ptr     ;
  "( -a ) Address at end of buffer" :doc

  : add       ( c-  ) end ! ptr ++ terminate ;
  "( c- ) Add value to end of buffer" :doc

  : get       (  -c ) ptr -- end @ terminate ;
  "( -c ) Read and remove value from buffer" :doc

  : empty     (  -  ) start !ptr   terminate ;
  "( - ) Remove everything from the buffer" :doc

  : size      (  -n ) end start -   ;
  "( -n ) Number of values in buffer" :doc

  : set       ( a-  ) !buffer empty ;
  "( a- ) Set buffer to memory address and empty it" :doc
}}
;chain
"( - ) vocabulary for dealing with LIFO buffers" :doc

7.3 TODO | Generic Buffer

global chain: buffer' {{ variable buffer variable ptr

7.3.1 : terminate ( - ) 0 @ptr ! ;

—reveal—

7.3.2 : start ( -a ) @buffer ;

7.3.3 : end ( -a ) @ptr ;

7.3.4 : add ( c- ) end ! ptr ++ terminate ;

7.3.5 : get ( -c ) ptr – end @ terminate ;

7.3.6 : empty ( - ) start !ptr terminate ;

7.3.7 : size ( -n ) end start - ;

7.3.8 : set ( a- ) !buffer empty ;

}} ;chain

7.4 TODO ( Text Strings `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

with buffer'
chain: strings'
{{
  variables| len needle haystack flag right left src |
  : buffer  ( -a )
    @memory        STRING-LENGTH   -  ( tib     )
                   STRING-LENGTH   -  ( scratch ) ;
  : trim   ( $-$ )
    dup withLength + 1- dup @ 32 == [ 0 swap ! dup 1- -- trim ] &drop if ;
  : place  ( $$n- ) [ copy 0 ] sip here + ! ;
  : prep   (  $$- ) swap !haystack [ getLength !len ] [ !needle ] bi 0 !flag ;
  : move   (    - ) @haystack here @len place haystack ++ ;
  : cmp    (    - )
    @flag 0 != if; @needle here compare [ @haystack 1- !flag ] ifTrue ;
---reveal---
  : search   ( $$-f )
    flag off prep @haystack getLength [ move cmp ] times @flag ;
  "( $$-f ) Search for a string (2) within a string (1); return string starting with substring" :doc

  : findChar ( $c-a )
    !needle
    repeat @+
      dup 0   == [ 2drop 0 0 ] [ -1 ] if 0; drop
      @needle == [ 1-      0 ] [ -1 ] if 0; drop
    again ;
  "( $c-a ) Search for a character within a string; return string starting at the character" :doc

  : chop      ( $-$ ) tempString withLength over + 1- 0 swap ! ;
  "( $-$ ) Return a new string, with the last byte removed" :doc

  : getSubset ( $nn-$ )
    buffer 0 STRING-LENGTH fill
    !right !left !src
    @src @left + @right buffer swap copy buffer tempString ;
  "( $nn-$ ) Return a subset of ($) starting at (n1) with length of (n2)" :doc

  : trimLeft  ( $-$ ) [ @+ [ 32 == ] [ 0 != ] bi and ] while 1- ;
  "( $-$ ) Trim whitespace from left side of string" :doc

  : trimRight ( $-$ )
    buffer [ 0 STRING-LENGTH fill ] [ over getLength copy ] [ trim ] tri tempString ;
  "( $-$ ) Trim whitespace from right side of string" :doc

  : prepend ( $$-$ )
    buffer 0 STRING-LENGTH fill
    withLength buffer swap &copy sip
    &withLength dip buffer + swap copy buffer tempString ;
  "( $$-$ ) Append first string to second" :doc

  : append ( $$-$ ) swap prepend ;
  "( $$-$ ) Append second string to first" :doc

  : appendChar ( $c-$ ) swap tempString [ withLength + !+ 0 swap ! ] sip ;
  "( $c-$ ) Append character to a string" :doc

  : toLower  ( $-$ )
    tempString [ [ dup @ dup 'A 'Z within [ 32 + ] ifTrue swap ! ] 2 each@ ] sip ;
  "( $-$ ) Convert a string to all upper case" :doc

  : toUpper  ( $-$ )
    tempString [ [ dup @ dup 'a 'z within [ 32 - ] ifTrue swap ! ] 2 each@ ] sip ;
  "( $-$ ) Convert a string to all upper case" :doc
}}
  : reverse ( $-$ )
    dup tempString set
    &getLength [ withLength + 1- ] bi swap
    [ dup @ add 1- ] times drop
    start tempString ;
  "( $-$ ) Reverse the characters in a string; returns a new string" :doc

  : split ( $n-$$ )
    2over 0 swap getSubset &+ dip ;
  "( $n-$$ ) Split a string into two parts" :doc

  : splitAtChar ( $c-$$ )
    2over over swap findChar over - 1+ 0 swap getSubset [ findChar 1+ ] dip ;
  "( $c-$$ ) Search for a character and return two strings (up to and including (c), and after ($2))" :doc

  : splitAtChar: ( $"-$$ )
    @getToken .data ` splitAtChar ; immediate
  "( $``-$$ ) Parse for a character and call **splitAtChar**" :doc
;chain
without
"( - ) vocabulary with functions for dealing with strings" :doc

7.5 TODO | Text Strings

with| buffer' | chain: strings' {{ 7 elements len needle haystack flag right left src

7.5.1 : buffer ( -a ) here 8192 + ;

7.5.2 : trim ( $-$ )

dup withLength + 1- dup @ 32 =if 0 swap ! dup 1- – trim ;; then drop ;

7.5.3 : place ( $$n- ) [ copy 0 ] sip here + ! ;

7.5.4 : prep ( $$- ) swap !haystack [ getLength !len ] [ !needle ] bi 0 !flag ;

7.5.5 : move ( - ) @haystack here @len place haystack ++ ;

7.5.6 : cmp ( - )

@flag 0 <> if; @needle here compare [ @haystack 1- !flag ] ifTrue ; —reveal—

7.5.7 : search ( $$-f )

flag off prep @haystack getLength [ move cmp ] times @flag ;

7.5.8 : findChar ( $c-a )

!needle repeat @+ dup 0 =if 2drop 0 ;; then @needle =if 1- ;; then again ;

7.5.9 : getSubset ( $nn-$ )

buffer 0 1024 fill !right !left !src @src @left + @right buffer swap copy buffer ;

7.5.10 : trimLeft ( $-$ ) [ @+ [ 32 = ] [ 0 <> ] bi = ] while 1- ;

7.5.11 : trimRight ( $-$ )

buffer [ 0 1024 fill ] [ over getLength copy ] [ trim ] tri ;

7.5.12 : prepend ( $$-$ )

buffer 0 1024 fill withLength buffer swap dup &copy dip &withLength dip buffer + swap copy buffer tempString ;

7.5.13 : append ( $$-$ ) swap prepend ;

7.5.14 : toLower ( $-$ )

withLength 1+ [ buffer + [ @+ dup 'A 'Z within [ 'a + 'A - ] ifTrue ] dip ! ] iter drop buffer tempString ;

7.5.15 : toUpper ( $-$ )

withLength 1+ [ buffer + [ @+ dup 'a 'z within [ 'A + 'a - ] ifTrue ] dip ! ] iter drop buffer tempString ; }}

7.5.16 : reverse ( $-$ )

dup tempString set [ getLength ] [ withLength + 1- ] bi swap [ dup @ add 1- ] times drop start ;

7.5.17 : split ( $n-$$ )

over over 0 swap getSubset [ + ] dip ;

7.5.18 : splitAtChar ( $c-$$ )

2over over swap findChar over - 1+ 0 swap getSubset [ findChar 1+ ] dip ;

7.5.19 : splitAtChar: ( $"-$$ )

32 accept tib @ .data ` splitAtChar ; immediate ;chain

7.6 TODO ( Access Words Within Chains Directly `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

with strings'
: __^  ( "- )
  splitAtChar: ' find
  [ @d->xt findInChain [ [ @d->xt ] [ @d->class ] bi withClass ] &drop if ]
  &drop if ; parsing
"( ``- ) Allow direct access to functions in a chain" :doc

: :needs  ( $- )
  dup find nip
  &drop [ "library/" prepend chop ".rx" append :include ] if ;
"( $- ) Load a vocabulary from the library if not already loaded" :doc

: needs  ( "- )
  getToken :needs ;
"( ``- ) Load a vocabulary from the *library* if it is not already loaded (parsing)" :doc

 without

7.7 TODO | Access Words Within Chains Directly

with strings'

__^  ( "- )

splitAtChar: ' find [ @d->xt findInChain [ [ @d->xt ] [ @d->class ] bi do ] &drop if ] &drop if ; parsing

{{ variable old

7.7.1 : cut withLength over + 1- 0 swap ! ;

—reveal—

7.7.2 : needs ( "- )

@last !old getToken dup find nip &drop [ "library/" prepend cut ".rx" append :include ] if ; }} global

7.8 TODO | Files files

chain: files' {{ 3 elements fid fsize active

7.8.1 : io ( n-f ) 4 out wait 4 in ;

7.8.2 : done ( nn- ) 2drop active off ;

—reveal— 0 constant :R 1 constant :W 2 constant :A 3 constant :M

7.8.3 : open ( $m-h ) -1 io ;

7.8.4 : read ( h-f ) -2 io ;

7.8.5 : write ( ch-f ) -3 io ;

7.8.6 : close ( h-f ) -4 io ;

7.8.7 : pos ( h-n ) -5 io ;

7.8.8 : seek ( nh-f ) -6 io ;

7.8.9 : size ( h-n ) -7 io ;

7.8.10 : delete ( $-n ) -8 io ;

7.8.11 : slurp ( a$-n )

:R open !fid @fid size !fsize @fsize [ @fid read swap !+ ] times 0 swap ! @fid close drop @fsize ;

7.8.12 : spew ( an$-n )

:W open !fid @fid !fsize [ @+ @fid write drop fsize ++ ] times drop @fid close drop @fsize ;

7.8.13 : readLine ( h-a )

tib repeat over read dup 10 13 within 0 !if drop 0 !swap drop tib tempString ;; then !over 1+ again ;

7.8.14 : writeLine ( $h- )

!fid active on [ @+ dup 0 = &done [ @fid write drop ] if @active ] while ; }} ;chain

7.9 TODO ( types' `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

chain: types'
  0 constant ARRAY  ( -n )
  "( -n ) Type constant for arrays" :doc

  1 constant BUFFER ( -n )
  "( -n ) Type constant for buffers" :doc

  2 constant STRING ( -n )
  "( -n ) Type constant for strings" :doc

  3 constant LIST  ( -n )
  "( -n ) Type constant for linked lists" :doc
;chain
"( - ) vocabulary with constants for data types. Used with **each@**" :doc

: describe
  d' 0; cr
  dup d->class @ xt->d dup [ d->name ] [ drop "unknown" ] if "class: %s\n" puts
      d->doc @ dup [ ] [ drop "no documentation provided" ] if puts cr ;
"( ``- ) provide information about a function" :doc

7.10 TODO | types'

chain: types' 0 constant ARRAY ( -n ) 1 constant BUFFER ( -n ) 2 constant STRING ( -n ) 3 constant LIST ( -n ) ;chain

8 Appendix: Cleanup, save, and power off

8.1 -

hide =if hide !if hide >if hide <if hide then

global .s save bye

8.2 ( cleanup and save `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~` )

global .s save bye

9 END

10 tasklist

10.1 TODO make `okmsg` assignable, in case you just want to change the string.

10.1.1 perhaps this means using strings with known lengths

11 NOTE . the new w: scheme for building the dictionaries

http://forthworks.com/dev/corpse/article/204

Building Retro

Table of Contents

1 OUTPUT meta.rx

2 OUTPUT kernel.rx

3 Building Retro

4 [8/11] Stage 1: The Metacompiler

4.1 DONE Introduction

4.2 DONE IMAGE-SIZE

4.3 DONE variables

4.4 DONE allocate ram for new image

4.5 DONE target memory writer

4.6 DONE assembler

4.6.1 DONE def vm:

4.6.2 DONE opcode assemblers

4.7 [8/9] metacompler words

4.7.1 DONE def t-here

4.7.2 DONE def pad

4.7.3 DONE def endKernel

4.7.4 DONE def main:

4.7.5 DONE def label:

4.7.6 DONE def #

4.7.7 DONE def __#

4.7.8 DONE def $,

4.7.9 TODO def shrink

4.8 TODO Metacompiler

4.8.1 TODO def t: and i: { t: is done, but add a note about i: }

4.8.2 NOTE: the end-of-function marker

4.8.3 TODO def { =if <if >if !if then }

4.8.4 def jump:

4.8.5 DONE def repeat / again

4.8.6 TODO tallot

4.8.7 DONE variable factories

4.9 [3/6] functions to build the initial dictionary

4.9.1 TODO def entry word: data: { are these obsolete given p: w: m: ? and where is macro ??}

4.9.2 TODO def p: w: m:

4.9.3 TODO def :doc

4.9.4 DONE def patch

4.9.5 DONE def mark

4.9.6 DONE def setClass

4.10 DONE Image Relocator

4.11 TODO Avoid keymap issues

4.12 DONE Setup target memory for new image

5 [3/14] Stage 2: The Kernel

5.1 [0/1] Layout of the Image

5.1.1 TODO { update this text to reflect the new situation for TIB }

5.2 [2/4] Initial Variables

5.2.1 DONE last .. which

5.2.2 TODO |memory fb fw fh cw ch

5.2.3 DONE copytag, version, build, okmsg

5.2.4 TODO call pad { i think this moved up to the top ?? }

5.3 TODO DEF , { the heap writer }

5.4 [5/7] classes

5.4.1 DONE DEF withClass

5.4.2 DONE DEF .word

5.4.3 DONE DEF .macro

5.4.4 DONE DEF .data

5.4.5 DONE DEF .primitive

5.4.6 TODO classes for the words so far

5.4.7 TODO docs for the words so far { looks like these can be inlined...? }

5.5 TODO Primitives : dup .. !+

5.5.1 .

5.5.2 stack operations

5.5.3 bitwise operations { also logical operations since true is -1 }

5.5.4 memory operations

5.5.5 arithmetic operations

5.5.6 i/o operations

5.6 [2/9] Additional stack, variable, and math functions.

5.6.1 DONE wait

5.6.2 TODO over

5.6.3 TODO not

5.6.4 TODO on

5.6.5 TODO off

5.6.6 TODO / and mod

5.6.7 TODO negate

5.6.8 DONE do

5.6.9 TODO @+ / !+

5.7 TODO Core Compiler: here .. pop

5.7.1 | core compiler

5.8 TODO Conditionals and Flow Control : 0; .. again

5.8.1 | conditionals / flow control

1 OUTPUT `meta.rx`

2 OUTPUT `kernel.rx`

4 `[8/11]` Stage 1: The Metacompiler

4.2 DONE `IMAGE-SIZE`

4.7 `[8/9]` metacompler words

4.8.4 def `jump:`

4.8.5 DONE def `repeat` / `again`

4.9 `[3/6]` functions to build the initial dictionary

5 `[3/14]` Stage 2: The Kernel

5.1 `[0/1]` Layout of the Image

5.1.1 TODO `{ update this text to reflect the new situation for TIB }`

5.2 `[2/4]` Initial Variables

5.2.1 DONE `last` .. `which`

5.3 TODO DEF , `{ the heap writer }`

5.4 `[5/7]` classes

5.4.4 DONE DEF `.data`

5.4.5 DONE DEF `.primitive`

5.4.7 TODO docs for the words so far `{ looks like these can be inlined...? }`

5.5 TODO Primitives : `dup` .. `!+`

5.6 `[2/9]` Additional stack, variable, and math functions.

5.6.6 TODO `/` and `mod`

5.7 TODO Core Compiler: `here` .. `pop`

5.8 TODO Conditionals and Flow Control : `0;` .. `again`

5.9.1 DONE DEF `update`

5.10 TODO Console Input `break` / `keyXXX` .. `accept`

5.12 `[7/8]` Colon Compiler : `vector` .. `( .. )`

5.12.5 TODO DEF `:` { the "colon compiler" }

5.12.6 DONE DEF `[[`

5.12.7 DONE DEF `]]`

5.13 `[0/1]` Quotes : `quote` .. `[ .. ]`

5.14.4 DEF `dip`

5.14.5 DEF `sip`

5.16 `[4/6]` Strings

5.16.1 DONE def `compare`

5.16.2 DONE def `getLength` / `withLength`

5.16.3 DONE def `string`, `keepString`

5.16.4 TODO `{ keepString commentary - seems to be outdated }`

5.16.5 DONE def `atib`, `\quot`

5.16.6 TODO :devector and :is `{ move these! }`

5.17 TODO Number Parsing & Display `{what happened to the display?}`

5.17.2 DEF `nums`

5.18 TODO Startup : `boot` .. `run-on-boot`

5.19.1 { helpers for `find` }

5.19.2 DEF `find`

5.20 `[1/4]` Word Prefixes and "Not Found"