I recently looked into the book Starting Forth by Leo Brodie. The examples have been written and tested in GForth. These are my reading notes.
I had actually started with Thinking Forth 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 bit of creativity! The basic idea is to extend my tool chest of methods by studying a new and different programming language paradigm.
Chapter 1
These are very elementary and straightfoward problems:
1
2
3
4
5
6
7
8
9
10
| \ 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 auxiliary words hard-coded in.
|
Chapter 2
The quizzies in this chapter are simple, but I needed to rethink things in terms of RPN:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
| \ 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. Still, they require consistently thinking in RPN at all stages and to think in terms of stack effects:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
| \ 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 I 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.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
| \ 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 >
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 < 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| \ 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 challenging. 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
| ( 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
| \ 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 unusual 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
| \ 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 certain situations is something I was unaware of:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
| \ 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 function '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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
| \ 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!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
| \ 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 tools introduced in this chapter and were straightforward:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
| \ 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
| \ 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
| \ 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 exercises. They 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| \ 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
| \ 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
I find it compelling 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 Postscript Tutorial for an introduction.
There are further resources on Forth online. There is the Gforth tutorial which explains the specifics of the GNU implementation. And there is a Python implementation that teaches how to implement a Forth interpreter and compiler from first principles.
Which books on older programming languages have you read recently? What is the most important lesson you learned from them?