field-theory.org
the blog of wolfram schroers

Starting Forth in Gforth

I recently looked into Thinking Forth by Leo Brodie to learn about the origins of test-driven development and similar project management methods that are popular today, see this article.

Then I realized that I could benefit more if I actually invested the time and effort to brush up my Forth and work through the manual Starting Forth by the same author, first.

Admittedly, some concepts are a little dated. For example, the idea to use integer arithmetics when contemporary machines know how to do floating point at least as fast. On the other hand, it is also fascinating to see how far you can get with 16-bit integers and a little bit of creativity!

This page contains the solutions to the exercises in Gforth which in some aspects differs from the implementation discussed in the book. If you decide to study a different programming language paradigm and thus extend your tool chest of methods then please feel free to use this page as a reference for sample solutions!

Table of contents:

Chapter 1
Chapter 2
Chapter 4
Chapter 5
Chapter 6
Chapter 7
Chapter 8
Chapter 9
Chapter 10
Chapter 11
Summary

Chapter 1

These are very elementary and straightfoward problems. The solutions are simply:

\ Problem 1
: gift ( -- ) ." Bookends" ;
: giver ( -- ) ." Stephanie" ;
: thanks ( -- ) cr ." Dear " giver ." ," cr 8 spaces ." Thanks for the " gift ." ." ;

\ Problem 2
: ten.less ( n -- nred ) -10 + ;

\ Problem 3
\ The word 'thanks' is compiled fully with auxilliary words hard-coded in.

Chapter 2

The quizzies in this chapter are simple, but they need us to rethink things in terms of RPN:

\ Quizzie 2-a:
\ 1. a b + c *
\ 2. 3 a * b - 4 / c +
\ 3. a b * 200 /
\ 4. n 1+ n /
\ 5. x 7 * 5 + x *

\ 6. (a-b)/(a+b)
\ 7. a/(10b)

\ Quizzie 2-b:
\ 1.
: 2b1 ( c b a -- result ) * + ;
\ 2.
: 2b2 ( c a b -- result ) 4 * - 6 / + ;
\ 3.
: 2b3 ( a b -- result ) 8 * / ;
\ 4.
: 2b4 ( a b -- result ) * 200 / ;
\ 5. (requires 'dup word!)
: 2b5 ( a -- result ) dup 2 * 3 + * ;
\ 6. (requires 'swap' word!)
: 2b6 ( c a b -- result ) - swap / ;

\ Quizzie 2-c:
\ 1.
: 2c1 ( a b c -- c b a ) swap rot ;
\ 2.
: 2c2 ( a b -- a b a ) swap dup rot rot ;
\ 3.
: 2c3 ( a b c -- c a b ) rot rot ;
\ 4.
: 2c4 ( n -- result ) dup 1+ swap / ;
\ 5.
: 2c5 ( x -- result ) dup 7 * 5 + * ;
\ 6.
: 2c6 ( a b -- result ) over 9 * swap - * ;

The problems are not difficult, either. But they do require to consistently think in RPN at all stages and to think in terms of stack effects:

\ Problem 1
\ dup dup has stack effect ( a b -- a b b b ).
\ 2dup has stack effect ( a b -- a b a b ).

\ Problem 2
: 2reverse swap 2swap swap ;

\ Problem 3
: 3dup ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3 )
    rot dup 2swap swap dup 2swap dup 2swap rot rot swap ;
( The sample solution is simpler: )
: 3dup ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3 )
    dup 2over rot ;

\ Problem 4
: c2p4 ( c a b -- result )
    over + * + ;

\ Problem 5
: c2p5 ( a b -- result )
    2dup - rot rot + / ;

\ Problem 6
: convicted-of ( -- 0 ) 0 ;
: homicide ( long -- longer ) 20 + ;
: arson ( long -- longer ) 10 + ;
: bookmaking ( long -- longer ) 2 + ;
: tax-evasion ( long -- longer ) 5 + ;
: will-serve ( years -- ) . ." years" ;

Chapter 4

There were no exercises in chapter three, so let's continue right away with chapter four. Here we encounter Forth's uncommon syntax for branching. The case-instruction is not introduced, unfortunately. Which means that some pieces of code end up being nested and long-winded if-then blocks.

\ Problem 1
\ -1 (true)
\ 0  (false)
\ -1 (true)

\ Problem 2
\ Well ... humpf ...

\ Problem 3
: card ( n -- ) 18 <
    if ." under age"
    else ." alcoholic beverages permitted"
    then ;

\ Problem 4
: sign.text ( x -- )
    dup 0>
    if ." positive"
    else dup 0<
        if ." negative"
        else ." zero"
        then
    then drop ;

\ Problem 5
\ Replacing 'do' with '?do' is the easiest solution. It is also possible with:
: stars ( n -- )
    dup 0= if drop else 0 do [char] * emit loop then ;

\ Problem 6
: within ( n low high -- flag )
    rot dup rot < rot rot <= and ;

\ Problem 7
: guess ( n m -- n |  )
    2dup over =
    if ." correct!" 2drop drop
    else over <
        if ." too large"
        else ." too small"
        then drop then ;

\ Problem 8
: speller ( n -- )
    dup 0= if ." zero" else
    dup 0< if ." minus " negate then
    dup 1 = if ." one" else
    dup 2 = if ." two" else
    dup 3 = if ." three" else
    dup 4 = if ." four" else
    ." out of range"
    then then then then then drop ;

\ Problem 9
: trap ( a low high -- a |  )
    3dup dup rot = rot rot = and if ." you got it!" 2drop drop else
    3dup swap 1+ swap within if ." between" else ." not between" then 2drop then ;

Chapter 5

The ideas in this chapter are probably the most dated. It is still interesting to see fixed-point arithmetics in this approach, but it is not really of practical use today. Anyway, the exercises are quite simple:

\ Problem 1
: c5p1 ( a b c -- result ) */ negate ;

\ Problem 2
\ max max max .

\ Problem 4
: f>c ( f -- c ) 32 - 1000 1800 */ ;
: c>f ( c -- f ) 1800 1000 */ 32 + ;
: k>c ( k -- c ) 273 - ;
: c>k ( c -- k ) 273 + ;
: f>k ( f -- k ) f>c c>k ;
: k>f ( k -- f ) k>c c>f ;

\ Problem 3
\ 0 f>c .
\ 212 f>c .
\ -32 f>c .
\ 16 c>f .
\ 233 k>c .

Chapter 6

In this chapter things are finally getting very interesting. We get a first glimpse of the instruction stack and also some non-trivial code examples to work with. I have adapted the Gforth versions of the code:

( My own versions of compound and doubled. )
: r% ( total percent -- result ) 10 */ 5 + 10 / ;
: compount ( funds interest -- )
    21 1 do cr ." Year " i . ." Balance "
        >r dup r@ r% + dup . r> loop
    2drop ;
: doubled ( funds interest -- )
    over rot rot
    21 1 do cr ." Year " i . ." Balance "
        >r dup r@ r% + dup .
        2dup 2/ < if
             r> cr cr ." more than doubled in " i . ." years " leave
        then
    r> loop
    2drop drop ;

The problem set offers more involved challenges:

\ Problem 1
\ (It's better to use '?do' here to handle the special case 0 stars!)
: stars ( n -- )
    0 ?do [char] * emit loop ;

\ Problem 2
: box ( width height -- )
    cr 0 do dup stars cr loop drop ;

\ Problem 3
: \stars ( n -- )
    cr 0 do i spaces 10 stars cr loop ;

\ Problem 4
: /stars ( n -- )
    cr 1- 0 swap do i spaces 10 stars cr -1 +loop ;

\ Problem 5
: /stars ( n -- )
    cr begin
        1- dup spaces 10 stars cr
    dup 0= until drop ;

\ Problem 6
: diamond-slice ( width #stars -- )
    swap over + spaces stars cr ;
: diamond ( height -- )
    dup 0 do dup i diamond-slice loop
    dup 1- 0 swap do dup i diamond-slice -1 +loop drop ;
: diamonds ( n -- )
    cr 0 ?do 10 diamond loop ;

\ Problem 7
: doubled-after ( funds interest -- )
    over rot rot
    0 1 do
        cr ." Year " i . ." Balance " >r dup r@ r% + dup .
        2dup 2/ < if
             r> cr cr ." more than doubled in " i . ." years " leave
        then
    r> loop
    2drop drop ;

\ Problem 8
: ** ( x n -- x^n )
    dup 0= if 2drop 1 else
        over swap begin 1- dup 0>
        while >r over * r>
        repeat drop swap drop
    then ;

Chapter 7

This chapter introduces some really interesting concepts: The idea of a number formatter that is programmed with the full power of Forth! The first section about the binary representation of numbers is something most developers should be familiar with, but it is written very well and clear and thus deserves another read.

The code examples (needed for later) are:

\ Examples from chapter 7
hex
: .ph# ( d -- )
    <# # # # # 02d hold #s #> type ;
decimal
: .date ( d -- )
    <# # # # # [char] / hold # # [char] / hold # # #> type ;
: sextal ( b -- ) 6 base ! ;
: :00 # sextal # decimal [char] : hold ;
: sec ( s -- ) <# :00 :00 #s #> type ;
: .$ ( d -- )
    tuck dabs <# # # [char] . hold #s rot sign [char] $ hold #> type ;
: dr% ( dtotal percent -- dresult )
    10 m*/ 5 m+ 10 sm/rem nip 0 ;

The problems again involve the idea of fixed-point arithmetics. However, in this entire chapter there are notable deviations in the syntax for parsing numbers from this book when doing the problems with Gforth. The exercises are simple, but the fact that an overflow can occur in some situations is something many people are usually totally unaware of:

\ Problem 1
\ Simplest solution: -1 1 rshift .
\ Requested solution with a loop:
: n-max ( -- )
    1 dup begin nip dup 1 lshift 1+ dup 0< until drop . ;

\ Problem 2
\ When the 'or' instruction is on its own: The flags may not be
\ canonical, i.e. different from -1 or 0. Thus, the flag bits would
\ not get treated correctly if one of them was the negation of the
\ other one. E.g. if art-loving was -2 and music-loving was 2 then
\ 'or' would correctly yield -2, but '+' would incorrectly yield
\ 0. When combined with the other 'and' things get even worse: An
\ addition may shift the flag bits and this could mess up the mask
\ that an 'and' relies on.

\ Problem 3
\ We need the funciton 'ms' for sleeping n milliseconds.
: rings ( -- )
    3 0 do ." BELL" cr 7 emit 1000 ms loop ;

\ Problem 4
\ a. Rewrite the definitions:
: df>c ( df -- dc ) 320. d- 10 18 m*/ ;
: dc>f ( dc -- df ) 18 10 m*/ 320. d+ ;
: dk>c ( dk -- dc ) 2730. d- ;
: dc>k ( dc -- dk ) 2730. d+ ;
: df>k ( df -- dk ) df>c dc>k ;
: dk>f ( dk -- df ) dk>c dc>f ;
\ b. Formatted print of a number:
: .deg ( d -- )
    tuck dabs <# # [char] . hold #s rot sign #> type ;
\ c. Example conversions:
\ 0. df>c .deg
\ 2120. df>c .deg
\ 200. df>c .deg
\ 160. dc>f .deg
\ -400. dc>f .deg
\ 1000. dk>c .deg
\ 1000. dk>f .deg
\ 2330. dk>c .deg
\ 2330. dk>f .deg

\ Problem 5
\ a. Routine that evaluates the quadratic equation:
: c7p5 ( x -- dresult )
    dup 20 m* rot dup m* 7 1 m*/ d+ 5 m+ ;
\ b. Maximum x that does not overflow the above equation:
\ 7x^2 + 20x + 5 <= 2^64-1
\ x <= sqrt(2^63/7-5/7+(10/7)^2)-10/7
\ Using Python:
\ from __future__ import division
\ import math
\ print(math.floor(math.sqrt(2**63/7-5/7+(10/7)**2)-10/7))
\ x <= 1147878292
\ This result can be verified using Gforth via:
\ 1147878292 c7p5 d. ( does not overflow )
\ 1147878293 c7p5 d. ( causes overflow )

\ Problem 6
decimal
: binary ( -- ) 2 base ! ;
: c7p6 ( -- )
    cr 17 0 do
        ." Decimal" decimal i 3 u.r 2 spaces
        ." Hex" hex i 3 u.r 2 spaces
        ." Binary" binary i 6 u.r cr
    loop decimal ;

\ Problem 7
\ It doesn't work on Gforth just like the other ways of parsing double
\ numbers. Maybe it works on some systems, but I really wonder how
\ come the standard has left such things open ...  on the other hand,
\ it could also simply mean that a word named '..' has been defined at
\ some point and, consequently, I don't learn much at all.

\ Problem 8
: ph-form # # # # [char] - hold ;
: c7p8 ( dph# -- )
    2dup 10000000. du< if
        <# ph-form #s #>
    else
        <# ph-form # # # [char] / hold #s #>
    then type ;

Chapter 8

The concept of arrays and memory management are well presented in this chapter. The code examples from this chapter are collected here:

\ Examples from chapter 8:
0 constant reject
1 constant small
2 constant medium
3 constant large
4 constant extra-large
5 constant error
variable counts 5 cells allot

: reset ( -- )
    counts 6 cells erase ;
: counter ( counter# -- addr )
    cells counts + ;
: tally ( counter# -- )
    counter 1 swap +! ;
: category ( weight -- category )
    dup 18 < if reject      else
    dup 21 < if small       else
    dup 24 < if medium      else
    dup 27 < if large       else
    dup 30 < if extra-large else
                error
    then then then then then nip ;
: label ( category -- )
    case
        reject of ." reject " endof
        small  of ." small " endof
        medium of ." medium " endof
        large  of ." large " endof
        extra-large of ." extra-large " endof
        error of ." error " endof
    endcase ;
: eggsize ( size -- )
    category dup label tally ;
: report ( -- )
    page ." QUANTITY        SIZE " cr cr
    6 0 do i counter @ 5 u.r
        7 spaces
        i label cr
    loop ;

The highlight of the problem set is the TicTacToe game. For this one I have done a little more work and implemented error checking, alternate playing and verifying the victory conditions in Forth. Consequently, it grew a little longer, but it was an interesting exercise to write a non-trivial program in a stack-based language!

\ Problem 1
variable pie# 0 pie# !
variable frozen-pie# 0 frozen-pie# !
: bake-pie ( -- ) 1 pie# +! ;
: eat-pie ( -- )
    pie# @ 0= if ." What pie?"
    else -1 pie# +! ." Thank you!" then ;
: freeze-pies ( -- )
    pie# dup @ frozen-pie# +! 0 swap ! ;

\ Problem 2
: .base ( -- )
    base @ dup decimal . base ! ;

\ Problem 3
variable places
: m. ( d -- )
    places @ 0= if d.
    else
        tuck dabs
        <# places @ 0 do # loop [char] . hold #s rot sign #>
        type
    then ;

\ Problem 4
0 constant red
1 constant blue
2 constant green
3 constant orange
variable pencil-case 4 cells allot

: pencils ( counter# -- addr )
    cells pencil-case + ;
: c8p4 ( -- )
    23 red pencils !
    15 blue pencils !
    12 green pencils !
    0 orange pencils ! ;

\ Problem 5
10 constant test#
variable plot-test test# cells allot

\ Requires 'random.fs' which exports the word 'random ( n -- 0..n-1)'.
s" random.fs" included
: c8p5-init ( -- )
    test# 0 do 71 random i cells plot-test + ! loop ;

: plot-line ( addr -- )
    @ 0 ?do [char] * emit loop ;
: plot ( addr size -- )
    cr 0 ?do i 1+ 3 u.r space dup i cells + plot-line cr loop drop ;
\ Test this using: c8p5-init plot-test test# plot

\ Problem 6
9 constant board-size
0 constant field-empty
1 constant field-X
255 constant field-O
variable board board-size allot
: tictactoe-start ( -- )
    board board-size erase ; tictactoe-start
: separator ( -- ) cr 11 0 do [char] - emit loop cr ;
: tictactoe-board-type ( -- )
    cr board-size 0 do
        board i + c@ space
        case
            field-empty of space endof
            field-X     of ." X" endof
            field-O     of ." O" endof
        endcase
        i 3 mod 2 = if
            i 1+ board-size <> if separator then
        else ."  |" then
    loop cr ;
: do-move ( field figure -- )
    swap 1- board + dup c@ if
        ." Error - field not empty!" 2drop
    else c!
    then ;
: X! ( field -- ) field-X do-move tictactoe-board-type ;
: O! ( field -- ) field-O do-move tictactoe-board-type ;

\ Addition: Check for end-game conditions and valid moves!
\ (I used local variables here, otherwise this would be a pain!)
0 constant column
1 constant row
2 constant diagonal1
3 constant diagonal2
variable next-mover
: tictactoe-start ( -- )
    board board-size erase 1 next-mover ! ; tictactoe-start
: ?correct-player ( current -- flag ) next-mover @ = ;
: next-player ( -- )
    next-mover @ field-X = if field-O else field-X then next-mover ! ;
: ?moves-left ( -- flag )
    0 board-size 0 do
        board i + c@ 0= if 1+ then
    loop 0<> ;
: get-next-field ( n m -- figure )
    + board + c@ ;
: ?check-line { n dir -- flag }
    dir case
        column    of 3 endof
        row       of 1 endof
        diagonal1 of 4 endof
        diagonal2 of 2 endof
    endcase
    n 0 get-next-field
    dup 0<> if
        over n get-next-field
        rot 2* n get-next-field
        over = rot rot = and if
            dir case
                column    of ." Column " n 1+ .  endof
                row       of ." Row " n 3 / 1+ . endof
                diagonal1 of ." Diagonal "      endof
                diagonal2 of ." Diagonal /"      endof
            endcase ." completed." cr true
        else
            false
        then
    else
        2drop false
    then ;
: ?check-column ( n -- flag )
    column ?check-line ;
: ?check-row ( n -- flag )
    row ?check-line ;
: ?check-diagonal1 ( -- flag )
    0 diagonal1 ?check-line ;
: ?check-diagonal2 ( -- flag )
    2 diagonal2 ?check-line ;
: tictactoe-evaluate ( -- )
    ?moves-left if
        3 0 do
            i ?check-column
            i 3 * ?check-row
        loop
        ?check-diagonal1
        ?check-diagonal2
        or or or or or or or if
            ." GAME OVER -- congratulations!" cr tictactoe-start then
    else
        ." The game is a draw -- try harder next time!"
        cr tictactoe-start
    then ;
: do-move ( field figure -- )
    dup ?correct-player if
        swap 1- board + dup c@ if
            ." Error - field not empty!" 2drop
        else c! next-player then
    else ." Error - wrong player!" then ;
: X! ( field -- )
    field-X do-move tictactoe-board-type tictactoe-evaluate ;
: O! ( field -- )
    field-O do-move tictactoe-board-type tictactoe-evaluate ;

Chapter 9

This chapter goes very deep into the topics of memory, pointers and how the interpreter works. I found the presentation less clear than in previous chapters, though. It was not always apparent which words operated on which pointers and as these concepts are needed in later chapters it takes some trial and error to figure it out.

The problems only touched upon a small subset of the things introduced in this chapter and were straightforward:

\ Problem 1
: counts ( current n [word] -- total )
    ' rot rot 0 do over execute loop nip ;

\ Problem 2
\ here u.

\ Problem 3
\ pad here - u.
\ (On my Ubuntu Linux 10.04 LTS with Gforth 0.7.0 it was 104 bytes.)

\ Problem 4
\ These two are identical: `date .` and `' date >body .`.
\ For `base`, they are not the same -- it might not even work on some
\ systems as base is a user variable in a different location.

\ Problem 5
: word1 ( -- ) ." Hello, world." ;
: word2 ( -- ) 11 1 do r@ . loop ;
: word3 ( -- ) 50 0 do r@ 10 mod if else cr then [char] * emit loop ;
: nop ;
create code-array ' word1 , ' word2 , ' word3 , ' nop , ' nop , ' nop ,
: store-word ( n [word] -- )
    code-array swap cells + ' swap ! ;
: do-something ( n -- )
    assert( dup 0 > )
    assert( dup 7 < )
    1- code-array swap cells + @ execute cr ;

Chapter 10

This chapter was quite tough for me as the specification of strings is not consistent and things work different in Gforth. Furthermore, there is a bug with the >number word which expects 4 numbers on the stack, not just two as the documentation claims. I did not get this to work.

The examples from the chapter are:

\ Gforth version of non-portable string handling:
: "label"   ." Reject  Small   Medium  Large   Xtra lrgError   " ;
: label 8 * ['] "label" >body cell+ cell+ + 8 type space ;

\ Gforth version of portable string handling:
: "label"   c" Reject  Small   Medium  Large   Xtra lrgError   " ;
: label ( n -- ) 8 * "label" 1+ + 8 type  space ;
: label ( n -- ) 0 max 5 min label ;

( Form love letter )
: text ( delimiter -- )
    pad 258 bl fill word count pad swap move ;
create name 14 allot
create eyes 12 allot
create me   14 allot
: vitals
    [char] , text pad name 14 move
    [char] , text pad eyes 12 move
           1 text pad me   14 move ;
: letter   page
    ." Dear " name 14 -trailing type ." ,"
    cr ." I go to heaven whenever I see your deep "
    eyes 12 -trailing type space ." eyes. Can "
    cr ." you go to the movies Friday?"
    cr 30 spaces ." Love,"
    cr 30 spaces me 14 -trailing type
    cr ." P.S. Wear something " eyes 12 -trailing type
    space ." to show off those eyes!" ;

( Interactive session example )
: greet   cr ." What's your name?"
    tib 40 accept #tib ! 0 >in !
    1 text cr ." Hello, "
    pad 40 -trailing type ." , I speak Forth." ;

For the problem sets I have decided to deviate from the assignments and not use block-based file access at all. Instead, I looked up the words for file access in Gforth and solved the problems with standard files, instead. Consequently, I have skipped problem five:

\ Problem 1
: "steve-jobs"
    c" Being the richest man in the cemetery doesn't matter to me ... Going to bed at night saying we've done something wonderful... that's what matters to me." ;
: setup-quote ( -- )
    "steve-jobs" count 3 block swap cmove ;
: change ( c1 c2 -- )
    1024 0 do
        2dup swap 3 block r@ + dup c@ rot = if c! else 2drop then
    loop 2drop ;
\ Testing can be done with: `3 block 1024 -trailing type`

\ Problem 2
\ Generate the fortunes with a loop of `fortune -n 64 -s >> fortunes.txt`
include random.fs
0 value fd-in
0 value fortune#
: "fortune-file" c" fortunes.txt" ;
: set-fortune# ( -- )
    "fortune-file" count r/o open-file throw to fd-in
    0 begin
        1+ pad 64 fd-in read-line throw nip 0=
    until
    to fortune# fd-in close-file throw ;
: fortune ( -- )
    set-fortune#
    "fortune-file" count r/o open-file throw to fd-in
    fortune# random begin
        1- dup pad 64 fd-in read-line throw
        rot 0<= swap 0= or
        dup if pad rot .s cr -trailing type cr else nip then
    until
    drop fd-in close-file throw ;

\ Problem 3
: "lunar-calendar"
    c" Rat Ox Tiger Rabbit Dragon Snake Horse Ram Monkey Cock Dog Boar " ;
: sword ( addr delimiter -- addr )
    begin
        swap 2dup c@ <>
    while
        1+ swap
    repeat 1+ nip ;
: skip-words ( addr n -- addr )
    0 ?do bl sword loop ;
: type-word ( addr -- )
    begin
        dup c@ dup emit bl <>
    while
        1+
    repeat drop ;
: .animal ( n -- )
    0 max 11 min "lunar-calendar" 1+ swap skip-words type-word ;
: juneeshee ( year -- )
    4 - 12 mod .animal ;
\ There is a serious bug in the `>number` macro which differs from
\ it's documentation in
\ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Line-input-and-conversion.html#Line-input-and-conversion
: juneeshee ( -- )
    cr ." What is your year of birth? (YYYY) "
    4 0 do key dup emit pad r@ + c! loop
    base @ 10 base ! 0 0 pad 4 >number 2drop drop swap base !
    cr ." Your animal type is " juneeshee ;

\ Problem 4
\ I rather take the vitals from a file
\ `echo Alice,blue,Fred >> vitals.txt`
: "vitals-file" c" vitals.txt" ;
: .word ( addr -- addr )
    begin dup c@ dup dup [char] , <> swap bl <> and
    while emit 1+
    repeat drop 1+ ;
: letter ( address -- )
    page
    ." Dear " .word ." ,"
    cr ." I go to heaven whenever I see your deep "
    dup eyes 12 cmove .word space ." eyes. Can "
    cr ." you go to the movies Friday?"
    cr 30 spaces ." Love,"
    cr 30 spaces .word
    cr ." P.S. Wear something " eyes .word
    space ." to show off those eyes!" 2drop ;
: letters ( -- )
    "vitals-file" count r/o open-file throw to fd-in
    begin
        pad 1024 bl fill pad 1024 fd-in read-line throw
        swap 0> if pad letter key drop then
    0= until
    fd-in close-file throw ;

\ Problem 5
\ I'll skip this one as it uses blocks for disk access and I have
\ already written a couple of disk-access routines now that rely on
\ regular files (which seems to be more complicated).

Chapter 11

This is the last chapter with problems. The problems require a thorough understanding of the concepts of compile-time vs. run-time and how compilation works. This is explained quite well, although the difference between a “defining word” and a “compiling word” is has not been explained well enough in my opinion.

The examples from this chapter are:

\ Examples from chapter 11:
: characters ( # -- )   create dup , allot does> dup cell+ swap @ ;
: string ( # -- )   create dup , allot
                    does>  2dup @ u< 0= abort" Range error " + cell+ ;
: erased ( # -- )   here over erase allot ;
: 0string ( # -- )   create erased does> + ;
: array ( #rows #cols -- )   create dup , * allot
                             does>  ( member: row col -- addr )
                               rot over @ * + + cell+ ;

\ Shapes, using a defining word
decimal
: star   [char] * emit ;
: .row   cr 8 0 do
        dup 128 and if star else space then
        1 lshift
    loop drop ;
: shape   create 8 0 do c, loop
          does>  dup 7 + do i c@ .row -1 +loop cr ;
hex 18 18 3c 5a 99 24 24 24 shape man
    81 42 24 18 18 24 24 81 shape equis
    aa aa fe fe 38 38 38 fe shape castle        
decimal

The problems themselves are not difficult, but I had problems figuring out the last one, because it took me some experimenting with the user variables from the earlier chapter before I understood how I can access the rest of the command line repeatedly:

\ Problem 1
: loaded-by ( addr n [word] -- )
    create 2, does> 2@ included ;

\ Problem 2
: based. ( n [word] -- )
    create , does> @ base @ swap base ! swap . base ! ;

\ Problem 3
: plural ( addr [word] -- )
    create , does> @ swap 0 ?do dup execute loop drop ;

\ Problem 4
: tourne postpone do ; immediate
: retourne postpone loop ; immediate
: tourne-francaise 10 0 tourne i . cr retourne ;

\ Problem 5
: loops ( n [instr] -- )
    >in @ swap 0 ?do
        dup >in ! 0 word count evaluate
    loop drop ;

Summary

The source code on this page can also be downloaded as a single file:

Download Download a gzipped .tar-file.

It is very interesting to learn new concepts of programming. Stack-oriented languages have become unfashionable in recent years, although many elementary programming techniques are stack-oriented. The Postscript programming language is probably the language where most lines of codes have ever been written as every page rendered on a Postscript-printer is a program in that stack-oriented language, see e.g. this tutorial for an introduction.

There are some other interesting resources on Forth online. There is the Gforth tutorial which explains the specifics of the GNU implementation. And there is a very interesting Python implementation that teaches how to implement a Forth interpreter and compiler from first principles.