2022-05-22 07:44:50 +02:00
|
|
|
: rdup r> r> dup >r >r >r ;
|
|
|
|
: rdrop r> r> drop >r ;
|
|
|
|
: loop[ [ ' rdup lit ] , [ ' rdrop lit ] , ; immediate
|
|
|
|
: ]loop latest @ 8 + , ; immediate
|
|
|
|
: ( loop[ key 41 = ? ret ]loop ; immediate
|
|
|
|
|
|
|
|
( -------------------------------------------------------------------------
|
|
|
|
Phew!
|
|
|
|
OK, what we just did was add comments to our Forth.
|
|
|
|
|
|
|
|
The ( word starts a comment. The close-parenthesis ends a comment.
|
|
|
|
|
|
|
|
Remember that words are whitespace-delimited, so you need to put whitespace
|
|
|
|
after the ( so it is recognized as a word. You can't just launch straight
|
|
|
|
into writing your comment. That's why the start of this comment said,
|
|
|
|
|
|
|
|
( ----
|
|
|
|
|
|
|
|
and not,
|
|
|
|
|
|
|
|
(----
|
|
|
|
|
|
|
|
If you don't type a close-parenthesis you can have a multi-line comment,
|
|
|
|
like we are doing now.
|
|
|
|
|
|
|
|
In the few lines starting this file, we also gave ourself a better way of
|
|
|
|
writing loops, so now we don't have to muck around with the "rdrop ret"
|
|
|
|
return-from-caller trick quite so much!
|
|
|
|
|
|
|
|
Let's explain how it works.
|
|
|
|
|
2022-05-22 08:05:40 +02:00
|
|
|
LINE 1 : rdup r> r> dup >r >r >r ;
|
|
|
|
LINE 2 : rdrop r> r> drop >r ;
|
2022-05-22 19:31:38 +02:00
|
|
|
LINE 3 : loop[ [ ' rdup lit ] , [ ' rdrop lit ] , ; immediate
|
2022-05-22 08:05:40 +02:00
|
|
|
LINE 4 : ]loop latest @ 8 + , ; immediate
|
2022-05-22 07:44:50 +02:00
|
|
|
|
|
|
|
Line 1-4 are defining a new loop construct called loop[ ... ]loop that
|
|
|
|
makes a word tail-recursive.
|
|
|
|
|
|
|
|
We already talked about "tail call optimization" in frustration.rs, when we
|
|
|
|
hand-made a very bad version of it. Now it's time to use Forth to make a
|
|
|
|
better one that is less annoying to use.
|
|
|
|
|
|
|
|
Let's lay out a tail-recursive word in memory like this:
|
|
|
|
|
|
|
|
[ Link field ]
|
|
|
|
[ Name field ]
|
|
|
|
[ --- Start of code field --- ]
|
2022-05-22 19:52:35 +02:00
|
|
|
[ Subroutine call to duplicate the return address ] <--- A
|
2022-05-22 07:44:50 +02:00
|
|
|
[ Subroutine call to drop the return address ] <--- B
|
|
|
|
|
|
|
|
... Your code goes here ...
|
|
|
|
|
|
|
|
[ Subroutine call to B ]
|
|
|
|
[ RET ] <---------------------------------------------- C
|
|
|
|
|
2022-05-22 10:24:18 +02:00
|
|
|
The loop[ word puts the two subroutine calls at the start of the code field.
|
|
|
|
The ]loop word puts the one subroutine call at the end of the word.
|
2022-05-22 07:44:50 +02:00
|
|
|
Later we will talk about how they managed to do that.
|
|
|
|
|
|
|
|
The rdup word is the "subroutine to duplicate the return address".
|
|
|
|
The rdrop word is the "subroutine to drop the return address".
|
|
|
|
|
|
|
|
Here is why it works.
|
|
|
|
|
|
|
|
Start of tail-recursive subroutine: Return-stack: { caller }
|
2022-05-22 19:53:45 +02:00
|
|
|
At the end of line A: Return-stack: { caller caller }
|
|
|
|
At the end of line B: Return-stack: { caller }
|
2022-05-22 07:44:50 +02:00
|
|
|
|
|
|
|
In other words, the back-to-back calls to A and B cancel each other out.
|
|
|
|
|
|
|
|
In the body of the loop: Return-stack: { caller }
|
|
|
|
|
|
|
|
Meaning you can break out of the loop with RET.
|
|
|
|
|
2022-05-22 19:53:45 +02:00
|
|
|
At subroutine call to line B: Return-stack: { caller C }
|
|
|
|
At the end of line B: Return-stack: { caller }
|
2022-05-22 07:44:50 +02:00
|
|
|
|
|
|
|
And now we are at the top of the loop again.
|
|
|
|
|
|
|
|
So values are not building up on the return stack forever, and
|
|
|
|
we have got the tail recursive behavior we want, hooray!
|
|
|
|
|
|
|
|
How the loop[ and ]loop words work:
|
|
|
|
|
|
|
|
There is a pattern used in this code that is probably unfamiliar to
|
|
|
|
you:
|
|
|
|
|
|
|
|
[ ' xyz lit ] ,
|
|
|
|
|
|
|
|
What this does is:
|
|
|
|
[ starts interpreting
|
|
|
|
' xyz looks up the address of word xyz
|
|
|
|
lit emits code that pushes the address to the stack
|
|
|
|
] starts compiling
|
|
|
|
, takes the address of xyz, which is now on the stack, and
|
|
|
|
compiles a subroutine call to xyz
|
|
|
|
|
|
|
|
Put another way, typing out:
|
|
|
|
|
|
|
|
: example [ ' xyz lit ] , ; immediate
|
|
|
|
|
|
|
|
actually compiles:
|
|
|
|
|
|
|
|
: example 12340 , ; immediate
|
|
|
|
{where 12340 is the address of xyz.}
|
|
|
|
|
|
|
|
except Forth looked up that address for you, so you didn't have to
|
|
|
|
hard-code 12340.
|
|
|
|
|
|
|
|
And then, because example is an immediate-word,
|
|
|
|
typing out:
|
|
|
|
|
|
|
|
: example-2 example ;
|
|
|
|
|
|
|
|
actually compiles:
|
|
|
|
|
|
|
|
: example-2 xyz ;
|
|
|
|
|
|
|
|
Going back to the real code that we just wrote,
|
|
|
|
typing out:
|
|
|
|
: loop[ [ ' rdup lit ] , [ ' rdrop lit ] , ; immediate
|
|
|
|
|
|
|
|
actually compiles:
|
|
|
|
: loop[ AAAAA , BBBBB , ; immediate
|
|
|
|
{where AAAAA is the address of rdup and
|
|
|
|
BBBBB is the address of rdrop}
|
|
|
|
|
|
|
|
which means that typing out:
|
|
|
|
loop[
|
|
|
|
|
|
|
|
actually compiles:
|
|
|
|
rdup rdrop
|
|
|
|
|
|
|
|
As an end result, we now have a rather nice way of writing loops, that
|
|
|
|
doesn't involve the programmer manually fiddling with the return stack
|
|
|
|
any more.
|
|
|
|
|
|
|
|
Forth interpreting mode and immediate-words are very powerful features.
|
|
|
|
This is how a small ~1 KB language core can extend itself into a "problem
|
|
|
|
oriented language" in a short amount of time.
|
|
|
|
|
|
|
|
Finally we use the tail-recursion feature we just added to the language,
|
|
|
|
to add comments to the language.
|
|
|
|
|
|
|
|
LINE 5 --> : ( loop[ key 41 = ? ret ]loop ; immediate
|
|
|
|
|
|
|
|
: ( Start defining a word called (
|
|
|
|
loop[ Make this a tail-recursive word
|
|
|
|
key Read a key code from stdin
|
|
|
|
41 = ? ret If it is close-parenthesis, we're done
|
|
|
|
]loop Otherwise, loop again
|
|
|
|
; immediate This will be an immediate-word, so it
|
|
|
|
executes immediately when it is seen.
|
|
|
|
------------------------------------------------------------------------- )
|
|
|
|
|
|
|
|
( Here is a riddle for you )
|
|
|
|
|
|
|
|
: :noname ( -- xt ) here @ [ ' ] , ] ; immediate
|
2022-05-22 08:05:40 +02:00
|
|
|
|
2022-05-22 19:52:35 +02:00
|
|
|
:noname drop rdrop ;
|
2022-05-22 07:44:50 +02:00
|
|
|
: stars ( n -- ) loop[ dup 0= ? [ , ] 1 - 42 emit ]loop ;
|
|
|
|
|
|
|
|
( How does the above code work?
|
|
|
|
You can run "stars" as follows:
|
|
|
|
|
|
|
|
Input: 8 stars
|
|
|
|
Result: ********
|
|
|
|
|
|
|
|
Input: 36 stars
|
|
|
|
Result: ************************************
|
|
|
|
)
|