Forth 语言简明教程

赵宇 张文翠 编译

原作者 Richard E. Haskell

Dept. of Computer Science and Engineering Rochester,

Michigan 48309

原文标题 《 The Forth Course 》

前言

什么是 Forth ？我们为什么要学习 Forth ？

Forth 是这样一种程序设计语言……

•  由 Charles Moore 在上个世纪七十年代早期发明；

•  是可扩展的；

•  在字典中保存所有的定义；

•  极其紧缩；

•  支持递归；

•  可以在 RAM 和 ROM 两种类型的存储器中运行 ;

•  结构化；

•  使用堆栈和后缀表示法；

•  模块化程度极高；

•  支持交互式开发和运行；

•  特别易于调试；

•  非常便于访问机器硬件；

•  运行速度很快，还包含一个汇编器；

•  语言系统是便携式的（开发环境和编译器尺寸极小）；

•  可以完全理解；

•  能够在硬件支持的 Forth 处理器上执行；

•  几乎在每一种通用的和不通用的微处理器上实现；

•  用了之后就无法放弃；

•  与其它程序设计语言差异很大；

你现在读到的就是 Forth 程序设计语言教程，它由 11 个部分组成，每个部分为一课，总的目标是简化学习 Forth 的过程。

本教程的素材来自于作者几年来的 Forth 语言教学实践，它们作为 Oakland University in Rochester, Michigan 嵌入式软件设计和计算机系统科学课程的一部分，为大学生和研究生讲授，并作为计算机工程、电子工程、计算机科学和工程、系统工程和计算机科学的主修课。

在课程开始的时候，没有人知道 Forth ，甚至大多数人都没有听说过它，到了课程结束的时候，有些人（通常是计算机科学类的学生）表示再也不想见到这种语言了！另一方面，其它的人（大多数都是工程类的学生）发现 Forth 真是一个他（她）们需要的、用来解决某些真实世界问题的工具，而且是“一但拥有、别无所求”。

现在你将要学习本课程。我们假设你懂得一些其它的程序设计语言（比如 Pascal, Fortran 或者 Basic ），如果理解 8088/8086 汇编语言会很方便，但这不是必须的，如果想学习汇编语言，现在有不计其数的 8088/8086 汇编语言教程。

我们的课程将采用 F-PC 3.5 Forth 系统，这是一个庞大的、功能齐全的、独立的 Forth 系统，由于 Tom Zimmer 的努力而开发完成。这个版本包含了许多你认为应该在一个优秀的程序设计语言中包含的特点，还有许多你从来就没有想到的功能，比如一个集成的超文本系统。当然， F-PC 系统的许多功能你可能不会用到，还有一些可以在需要的时候再学习。

通过本课程的学习，你会得到许多背景知识以及 F-PC 系统有价值的信息，希望这能够为你打开一个新的、强大的程序设计之路。

原作者 R. E. Haskell， 1990 年 8 月

译者注：本教程所使用的软件可以通过网上下载，参看 Forth 简体中文网 资源，这里是 FPC 3.6 本地下载 ,ZIP文件可以使用通用的ZIP工具或者 WinRAR工具解压。

目录

第一课 Forth 语言简介

第二课 使用 F-PC

第三课 Forth 是如何工作的

第四课 Forth 判断

第五课 Forth 中的数

第六课 字符串

第七课 CODE 字和 DOS I/O

第八课 定义字

第九课 编译字

第十课 Forth 数据结构

第十一课 使用中断的终端程序

第一课 Forth 语言简介

1.1 介绍 Forth

下面列出的几条文字非常简单，但它能够完整地描述 Forth 程序设计语言：

•  Forth 中的每一个事物都是一个字（ word ）；

•  Forth 字必须用空格分开；

•  Forth 字存储在字典中；

•  Forth 字可以被解释，也可以被编译；

•  在解释模式下，一个 Forth 字被执行；

•  在编译模式下，一个 Forth 字被存储到字典中；

•  你可以通过把一串 Forth 字组合在一起而形成 Forth 短语；

•  如果你打入一个 Forth 字并且后随 <Enter>, 它将被执行（解释模式）；

•  如果你打入一个数（比如 6）并按下 <Enter>, 这个数将作为一个 16 位的无符号数存储到堆栈上；

•  Forth 广泛使用堆栈在字间传递参数。这就意味着 Forth 应用程序对变量的使用将显著减少；

•  你可以在 Forth 中定义一个新的字（使用早先已经定义的 Forth 字），它会成为 Forth 字典的一部分，可以像其它的 Forth 字一样使用。

1.2 Forth 算术

Forth 使用堆栈和后缀表示法进行算术运算。

包括 F-PC 在内的许多 Forth 系统，其堆栈都存储 16 位的值。 32 位的 Forth 系统比如 MacForth 在堆栈上存储 32 位的值。在 16 位的 Forth 系统中，堆栈上的值将占2个字节的位置，在 32 位的 Forth 系统中，堆栈上的值将占 4 个字节的位置。

当你打入一个数的时候，它就被放到堆栈上。你可以用任何的基数来输入数，我们后面将看到如何改变数基。默认的数基是十进制。因此，如果你打入 35 ， 16 进制的 23H （后缀 H 表示是一个 16 进制数）将按以下的格式存储在堆栈上：

如果你输入 2 个数，中间以空格分开，它们都将存储到堆栈上。

例如，你输入：

127 （空格） 256

两个 16 进制数 7Fh 和 100h 将按以下方式存储在堆栈上：

打入 .S ( 或者 .s ，对于大多数 Forth 系统来说，大小写没有关系 ) 将非破坏性地显示堆栈内容，顺序是先打印栈底部的内容，再打印栈顶的内容。

127 256 .s 127 256 ok

这里， ok 是 Forth 的提示符，数值按 2 的补码方式存储在堆栈上。

16 位 Forth 系统在堆栈上可以存储值的范围是 -32,768 到 +32,767 ，32 位系统可以在堆栈上存储值的范围是 -2,147,483,648 到 +2,147,483,647.

1.3 Forth 算术操作

Forth 字 . ( 读作点或者 dot) 可以打印栈顶元素的值

7 9 . . 将打印出 9 和 7

回车通常被 Forth 忽略或者作为一个空格对待，它可以使程序更易读。采用“垂直”风格编写程序，我们可以很容易地用一个反斜杠 / 来说明“堆栈的组织结构”，反斜杠之后直到这一行尾的任何内容都作为注释而被忽略。

例如，为了解释上面例子的每一步的堆栈情况，我们可以这样写：

7 / 7

9 / 7 9

. / 7

. /

注意，点从堆栈移去一个值。

Forth 字 + ( 加 ) 把栈顶的两个值相加并把结果放到堆栈上，例如：

7 9 + . 将打印 16

7 / 7

9 / 7 9

+ / 16

. /

Forth 字 - ( 减 ) 将用栈顶元素减去次栈顶元素并把结果差放到栈顶。

8 5 - . 将打印 3

8 / 8

5 / 8 5

- / 3

. /

Forth 字 * ( 乘法 ) 把栈顶的两个值相乘，积留在堆栈上。

4 7 * . 将打印 28

4 / 4

7 / 4 7

* / 28

. /

Forth 字 / （除法）实现除法，栈顶元素为除数，次栈顶元素为被除数，商留在堆栈上。

8 3 / . 将打印 2

8 / 8

3 / 8 3

/ / 2

.

1.4 堆栈管理字

堆栈的说明通常使用这样的格式 ( before -- after ) ，其中

before = 这个字被执行之前的栈顶元素；

after  = 这个字被执行之后的栈顶元素

DUP ( n -- n n )

复制栈顶元素，如 5 DUP . . 将打印 5 5

5 / 5

DUP / 5 5

. / 5

. /

SWAP ( n1 n2 -- n2 n1 )

交换堆栈上的两个元素，如 3 7 SWAP . . 将打印 3 7

3 / 3

7 / 3 7

SWAP / 7 3

. / 7

. /

DROP ( n -- )

移去栈顶元素，如 6 2 DROP . 将打印 6

6 / 6

2 / 6 2

DROP / 6

.

OVER ( n1 n2 -- n1 n2 n1 )

复制次栈顶元素，如 6 1 OVER . . . 将打印 6 1 6

6 / 6

1 / 6 1

OVER / 6 1 6

. / 6 1

. / 6

.

TUCK ( n1 n2 -- n2 n1 n2 )

复制栈顶元素到次栈顶元素之下，这个操作等效于 SWAP OVER

如 6 1 TUCK . . . 将打印 1 6 1

6 / 6

1 / 6 1

TUCK / 1 6 1

. / 1 6

. / 1

.

ROT ( n1 n2 n3 -- n2 n3 n1 )

旋转堆栈上的三个元素，原来的第三个元素变成了第一个元素

如 3 5 7 ROT . . . 将打印 3 7 5

3 / 3

5 / 3 5

7 / 3 5 7

ROT / 5 7 3

. / 5 7

. / 5

.

-ROT ( n1 n2 n3 -- n3 n1 n2 )

反向旋转堆栈顶部的三个元素，栈顶元素被旋转到了第二位置

如 3 5 7 -ROT . . . 将打印 5 3 7

3 / 3

5 / 3 5

7 / 3 5 7

-ROT / 7 3 5

. / 7 3

. / 7

.

NIP ( n1 n2 -- n2 )

从堆栈上移去第二个元素，这个操作等效于 SWAP DROP ，如 6 2 NIP . 将打印 2

6 / 6

2 / 6 2

NIP / 2

.

2DUP ( n1 n2 -- n1 n2 n1 n2 )

复制栈顶两个元素，如 2 4 2 DUP .S 将打印 2 4 2 4

2SWAP ( n1 n2 n3 n4 -- n3 n4 n1 n2 )

把栈顶的两个元素与第三个和第四个元素交换，如 2 4 6 8 2SWAP .S 将打印 6 8 2 4

2DROP ( n1 n2 -- )

从堆栈上移去栈顶两个元素

PICK ( n1 -- n2 )

从栈顶计算 n1 位置（不包含 n1 ），把这个位置的值复制到栈顶，栈顶与 n1 位置对应的是 0.

0 PICK 等效于 DUP

1 PICK 等效于 OVER

2 4 6 8 2 PICK .S 将打印 2 4 6 8 4

ROLL ( n -- )

旋转位置 n ( 不包含 n) 到栈顶， n 必须大于 0.

1 ROLL 等效于 SWAP

2 ROLL 等效于 ROT

2 4 6 8 3 ROLL .S 将打印 4 6 8 2

1.5 更多的 Forth 字

MOD ( n1 n2 -- n3 )

n1 除以 n2 并把余数 n3 留在堆栈上。

8 3 MOD . 将打印 2

/MOD ( n1 n2 -- n3 n4 )

n1 除以 n2 并把商 n4 放到栈顶、余数 n3 作为次栈顶。

10 3 /MOD .S 将打印 1 3

MIN ( n1 n2 -- n3 )

把 n1 和 n2 之中最小的一个放到栈顶。

8 3 MIN . 将打印 3

MAX ( n1 n2 -- n3 )

把 n1 和 n2 之中最大的放到栈顶。

8 3 MAX . 将打印 8

NEGATE ( n1 -- n2 )

改变 n1 的符号。

8 NEGATE . 将打印 -8

ABS ( n1 -- n2 )

把 n1 的绝对值放到栈顶 .

-8 ABS . 将打印 8

2* ( n1 -- n2 )

通过执行算术移位把 n1 乘 2

8 2* . 将打印 16

这个操作等效于 8 2 * 但是执行得更快。

2/ ( n1 -- n2 )

通过执行算术右移把 n1 除以 2 .

8 2/ . 将打印 4

这个操作等效于 8 2 / 但是更快。

U2/ ( n1 -- n2 )

执行 16 位的逻辑右移。 .

40000 U2/ . 将打印 20000

但是 40000 2/ . 将打印 -12768

8* ( n1 -- n2 )

通过执行 3 位算术移位实现 n1 乘 8.

7 8* . 将打印 56

这等效于 7 8 * 但是更快

1+ ( n1 -- n2 )

把栈顶元素增 1

1- ( n1 -- n2 )

把栈顶元素减 1

2+ ( n1 -- n2 )

把栈顶元素加 2 .

2- ( n1 -- n2 )

把栈顶元素减 2 。

U/16 ( u -- u/16 )

u 是一个无符号的 16 位整数，通过执行一个 4 位的右移而实现 u 除以 16.

1.6 冒号定义

你可以引用其它的 Forth 字来定义自己的 Forth 字，方法是使用 Forth 字 :( 冒号 ) ，就像下面这样：

: <name> --- --- --- --- ;

其中冒号 : 开始一个定义， <name> 是你自己要定义 Forth 字的名字， --- --- 是组成这个定义字的具体内容，而分号 ; 结束这个定义

下面是一些定义的例子：

如果你不喜欢用点来打印栈顶的值，你可以把它定义成 = = 两个等号，因为一个等号已经是一个 Forth 字了。

注意：上面的左括号'（ '是一个 Forth 字，它把从它开始直到右括号之间的内容作为一个注释。因此，它们必须被空格分开，在'（' 之后必须有一个空格。

: = = ( n -- ) / 打印栈顶值

. ;

打入这个冒号定义，试着再打入 5 7 + = =

: squared ( n – n * * 2 ) / 计算 n 的平方，方法是一个自身相乘

DUP * ;

可以试着打入 5 squared = =

3 squared = =

7 squared ==

: cubed ( n -- n**3 ) / 计算 n 的立方

DUP / n n

squared / n n**2

* ; / n**3

以下是两个有用的 Forth 字

CR ( -- ) ( 读作回车 )

在屏幕上产生回车和换行

." ( -- ) ( 读作点引号 )

打印字符串，直到闭括号 "

我们还可以定义下列字

: bar ( -- ) / 打印一个杠

CR ." *****" ;

: post ( -- ) / 打印一个位置

CR ." *"

CR ." *" ;

: C ( -- ) / 打印一个 C

bar post post bar ;

: F ( -- ) / 打印一个 E

bar post bar post ;

我们看到，新的 Forth 字是用以前的 Forth 字定义而成的。这就是 Forth 的方式。新的、更强大的字被不断地定义，当你完成全部的程序时，程序还是一个字。

你定义的字和预定义的 Forth 字一样被存储在 Forth 字典中。 Forth 解释器不知道你定义的 Forth 字和语言预定义的字两者之间的差异。这就意味着每个 Forth 应用程序实际上都将是一种特殊的语言，这种语言被设计得用来解决你自己的、特殊的问题。

1.7 练习

一个正方形可以用它的左上角 (t l) 和右下角坐标来定义。令 X 坐标从左向右增加， Y 坐标从上向下增加。定义三个 Forth 字： AREA 、 CIRCUM 和 CENTER ，它们将根据给定的顶、左、底、右计算出面积、周长和中心。

AREA ( t l b r -- area )

CIRCUM ( t l b r -- circum )

CENTER ( t l b r -- xc yc )

用下面的给定值来测试你定义的字：

顶 : 31 10

左 : 16 27

底 : 94 215

右 : 69 230

第二课 使用 F-PC

2.1 使用 SED 编辑文件

全屏幕编辑器 SED 用于编写程序并把它们作为磁盘文件而永久保存。例如，为了编写程序以解决练习 1.1 的问题，我们进入 F-PC ，在 ok 提示符下输入

newfile hw1

这将创建一个新的顺序文件 HW1.SEQ. 所有的 F-PC 源文件都用 .SEQ 作扩展名。

你的程序第一行应该使用一个 / 开始并写上你的程序或者文件的名称。当你打印一个程序列表时，每页的第一行将被打印出来，你可以通过输入以下命令实现：

FPRINT HW1.

在文件的第二行，你输入一个 / 和一个 TAB ，然后输入 Alt-O P. 这将粘贴上日期和时间。现在就可以输入完整的程序了：

/ Homework #1

/ 07/02/89 08:25:20.35

/ Exercise 1.1 -- Lesson 1

/ Find area, circumference and center of rectangle

: sides ( t l b r -- r-l b-t )

ROT / t b r l

- / t b r-l

-ROT / r-l t b

SWAP - ; / r-l b-t

: area ( t l b r -- area )

sides * ;

: circum ( t l b r -- circum )

sides + 2* ;

: center ( t l b r -- xc yc )

ROT / t b r l

+ / t b r+l

2/ / t b xc

-ROT / xc t b

+ 2/ ; / xc yc

注意一个中间的字 SIDES 定义把值 (right-left) 和 (bottom-top) 留在栈上，然后字 SIDES 用于定义 AREA 和 CIRCUM 。

F-PC 是大小写不敏感的，这就是说你可以任意地使用大写或者小写字母。在本课程中，我们通常是这样处理的：

自己定义的字使用小写字母，在我们定义中使用的 F-PC 字用大写字母。

这就能够很方便地识别出一个定义字中哪些是 F-PC 的定义字，哪些是我们自己在的定义的。

另外需要注意的是，在 SIDES 和 CENTER 定义中，我们使用了在每一行的右边写堆栈注释的方式，你会看到，随着堆栈处理的继续，这种方法会变得很有用。

SED 编辑器有全功能的编辑能力，它在 F-PC 用户手册的第五章中描述，包含在 F-PC 的软件包中。

输入完程序之后，你可以通过 F10 功能键退出 SED 。这时你还可以编辑另外的文件，只需要输入文件名，如果你不需要编辑其它文件，则按 ESC 键，进入到 F-PC 的 ok 提示符状态。现在可以装入和运行程序。你也可以打入 ED 命令而进入刚才的编辑器。

2.2 装入和运行你的程序

为了运行文件 HW1.SEQ 中的程序，你打入

fload hw1

装入的过程是把文件中所有的冒号定义加入到字典中，它与你在 F-PC 交互模式下打入全部程序的效果是一样的。当然，它们之间差异是所有的冒号定义现在都保存在磁盘上并可以随时编辑它们。

如果你使用练习 1.1 的数据来测试它们，你可以得到下列结果：

31 16 94 69 area . 3339

31 16 94 69 circum . 232

31 16 94 69 center . . 62 42

 

10 27 215 230 area . -23921

10 27 215 230 circum . 816

10 27 215 230 center . . 112 128

第二个面积等于 –23921 ，没有任何意义，但这是因为面积的值已经大于 32767 ，而 16 位数字在 BIT15 为 1 时表示一个负数。我们可以使用 Forth 字 U. (U-dot) 来打印它的真实值。字 U. 把栈顶的 16 位数作为一个无符号数来打印，这会产生下列结果

10 27 215 230 area u. 41615

2.3 调试你的程序

F-PC 有几个有用的字来帮助你调试程序。字 SEE 让你能够反编译一个字，例如，在 FLOAD 一个文件 HW1 之后，可以打入

see area

see sides

see circum

see center

注意，每个冒号定义都显示出来，这是通过查找字典中的每一个字和每个定义的名字而实现的。

字 VIEW 可以使你看到一个具体的定义存在于哪个文件中，并以文件中的样子显示每个实际的定义。打入：

view sides

它将把你带入编辑器的 BROWSE 模式，并显示 SIDES 在文件中的定义。这时，你也可以浏览文件的其它定义。打入 F10 和 ESC 返回 ok 提示符，此时你可以使用 ED 命令来编辑文件。 VIEW 能够查找任何一个 F-PC 字的定义。

F-PC 字 DEBUG 是一个强大的调试工具，它允许你在单步执行定义中每个字的同时观察堆栈的变化。在 FLOAD 之后打入

debug area

之后再执行 AREA 的时候，它将在定义中的每个字前暂停并显示堆栈的内容。打入除 Q, C, N, U, X 和 F 以外的任何键实现单步，例如

10 27 215 230 area

字义 AREA 将在屏幕的顶部显示，下面的内容是随着 3 个空格键之后在屏幕底部显示的

10 27 215 230 AREA [4] 10 27 215 230

12648 0 : SIDES ?> [2] 203 205

12648 2 * ?> [1] 41615

12648 4 UNNEST ?> ok

在每个定义的名字之后是按空格键执行的堆栈情况，堆栈上元素的数量在方特号 [ ] 显示，并显示堆栈顶 4 个元素的值。注意当两个值 203 和 205 相乘的时候，积 41615 显示成 -23921 ，事实上，当单步通过上面 AREA 的定义后，值 41615 依然保留在堆栈上。如果你打入 . (DOT) ，值 -23921 将显示。

打入 UNBUG 将终止 DEBUG ，当然 AREA 将不再按调试方式运行。在单步执行的时候，我们还可以打入：

Q 终止 DEBUG 并执行 UNBUG;

C 将继续执行到定义的尾或者按下了 <Enter> ;

F 将临时退到 Forth ( 扫 <Enter> 可以返回到单步调试字 ) ；

X 将触发源代码列表开关，并为调试提供全部的屏幕；

N 将递归进入调试的字；

U 退出调用的字；

S 允许你跳过 ( 以高速度 ) 到字义中的下一个字，你可以选择向前移动（使用 + ）和向后移动（使用 - ）直到你到达了一个字并按 <Enter> ，你可以使用 ESC 来终止这个过程。

作为一个递归的例子，打入 DEBUG AREA 然后打入

10 27 215 230 AREA

N 键将递归到字 SIDES ，单步通过这个定义，观察它是如何返回到字 AREA 定义的。

2.4 练习

建立一个文件 HW2.SEQ ，并在文件中输入以下的冒号定义

: stacktest ( a b -- ? )

DUP *

SWAP DUP

* + ;

在这个定义的每一行后面写上堆栈说明。

使用 FLOAD 读入文件，用 DEBUG 单步通过这个字，你可以输入

4 5 stacktest

在堆栈上有什么值？

第三课 Forth 是如何工作的

3.1 变量

Forth 字 VARIABLE 是一个定义变量名字的定义字，如果你打入

VARIABLE my.name

Forth 就会创建一个新字典项，它的名字是 my.name. 所有的字典项都有通用的格式，包含一个首部。

首部由不同的字段组成，包括 VIEW 字段、名字字段和链接字段。在 F-PC 中，首部和体物理上分别存储在不同的段中，也就是在x86的实模式中，1 M 字节的地址空间被分成为 64 K 字节的段，而一个物理地址由位的段地址 seg 和一个 16 位的偏移地址 off 组成，完整的地址形式是 seg:off 。段可以在 16 字节的边界开始，称为页。因此，为了寻址任何存储器字节，我们必须指定段地址和偏移量。

字 MY.NAME 的字典看起来是这样的

VIEW 字段是一个字符计数，它等于文件中冒号定义开始的偏移量。当使用 VIEW 命令时，这个字段可以在源程序文本中定位冒号定义。

链接字段包含一个指针，它指向前一个定义字的 LFA 。

名字字段包含名字，但第一个字节是名字的字符数，后面是 1-31 个字符，也就是定义的名字。

指向 CFA 的指针包含一个 CFA 在代码段的偏移量。代码段的地址在 F-PC 中通过 ?CS: 给出。

代码字段包含有代码，它在这个定义被解释时执行， F-PC 中使用直接串线编码，许多 Forth 系统使用间接串线编码，其中的代码字段含有一个指向执行代码的指针。对于 VARIABLE 来说，代码字段含有三个字节的指令，也就是 CALL NEXT ，这里的 NEXT 是 F-PC 的内层解释器，将在后面进行描述。 CALL 指令自动把下一指令的地址放到栈上，在我们的系统中，这却不是一个真正的指令地址，而是参数字段的地址。

对于不同种类的字，参数字段包含有不同的东西，对于 VARIABLE 字，参数字段包含这个变量的 16 位的值。初始值是 0.

如果你打入这个变量的名字，代码字段中的 CALL NEXT 指令将执行，它的作用是把参数字段的地址留在堆栈上。如果你打入

my.name .

my.name 的 PFA 将要被打印出来。可以试一下。

3.2 关于变量的更多内容 -- FETCH 和 STORE

Forth 字：

! ( n addr -- ) ( "store" )

把值 n 存入地址 addr ， 6 my.name ! 将把值 6 存入 my.name 的 PFA.

@ ( addr -- n ) ( "fetch" )

读出 addr 位置的值放到堆栈上， my.name @ . 将打印 my.name 的值。

堆栈变量

系统变量 SP0 包含有一个空的堆栈的堆栈指针，这样

SP0 @

将返回堆栈没有任何内容时的堆栈指针的地址。

Forth 字 SP@ 返回最后一个元素压入堆栈后的地址，于是，它就是堆栈指针的当前值。

Forth 字 DEPTH 返回堆栈上元素的数量，它是这样定义的：

: DEPTH ( -- n )

SP@ SP0 @

SWAP - 2/ ;

注意由于堆栈上每个元素都包含两个字节，堆栈元素的数量必须除以 2

3.3 常数

Forth 字 CONSTANT 是一个用来定义常数的定义字，例如你输入

25 CONSTANT quarter

名字 quarter 将按以下的方式进行字典：

代码字段包含有三个字节，它对应指令 CALL DOCONSTANT 。而 DOCONSTANT 从堆栈上弹出 PFA （它是被 CALL 指令压入的），然后把 FPA 的值放到堆栈上，这样，如果你先输入

25 CONSTANT quarter

然后再输入 quarter . 则值 25 就打印出来。注意， CONSTANT 存储的数是 16 位的无符号数。

3.4 Forth 冒号字义

Forth 字 : (读作“冒号”) 也是一个定义字，它允许你定义新的 Forth 字，如果你输入：

: squared DUP * ;

冒号字：被执行，它在字典中创建一个 Forth 字 squared ，如下所示：

代码字段包含的 3 个字节对应于指令 JMP NEST. 在 NEST 位置的代码是内层解释器的一部分，我们将在本教程的后面描述。

参数字段包含有列表段（list segment）的偏移量， 称为 LSO, 它的值被加入到列表段地址，这个地址存储在变量 XSEG. 中，结果的段地址存储在寄存器 ES 中，组成 squared 定义的代码字段列表存储的开始地址 ES:0.

UNNEST 是另一个子程序的地址，它也是 Forth 内层解释器的一部分。

3.5 数组

如果你想创建一个有五个 16 位数的数组，如果你输入：

VARIABLE my.array

则 Forth 会创建字典输入项 my.array 它在参数字段含有一个 16 位值

这里我们没有给出首部，注意参数字段包含有 2 个字节的 16 位值

Forth 字 ALLOT 将加入 n 字节将在字典的代码字段，这里 n 是 ALLOT 执行时从堆栈上得到的值，于是

8 ALLOT

将加入 8 个字节或者是 4 个字到字典中， my.array 字典项的代码段部分看起来像这样：

为打印 my.array(3) 的值，你必须是这样做：

my.array 3 2* + @ .

3.6 返回栈

你输入一个数，它就被放到参数栈上。所有的算术操作和 DUP 、 ROT 、 DROP 、 SWAP, OVER 这一类字的操作数都在参数栈上。

Forth 还有第二个堆栈，称为返回栈。返回栈被 Forth 的内层解释器使用以存储冒号定义执行时下一个字的地址，它也被特定的 Forth 字使用，比如 DO.

如果非常你很细心，那你也可以使用返回栈，但是，需要再次强调：细心 。你可以从参数栈上临时地移出一个数到返回栈，前提是你要保证在冒号定义结束之前已经把它移开了，否则，由于正确的返回地址并没有放在栈项，内层解释器就不能找到适当的地址。

下列 Forth 字用于返回栈， R ：

>R ( n -- ) ( "to-R" )

弹出参数栈的顶层元素，并把它压入返回栈

比如 3 >R 将把 3 移到返回栈，并留参数栈为空。

R> ( -- n ) ( "from-R" )

弹出返回栈顶元素，并把它压入参数栈。

R@ ( -- n ) ( "R-fetch" )

把返回栈栈顶元素复制到参数栈上。

这是一个可能的 ROT 字义：

: ROT ( n1 n2 n3 -- n2 n3 n1 )

>R / n1 n2

SWAP / n2 n1

R> / n2 n1 n3

SWAP ; / n2 n3 n1

3.7 CODE 字

Code 字是使用 8086 机器语言定义、而不是使用其它 Forth 字字义的字。当然，不论使用什么定义，最终都必须执行真正的 8086 机器代码，内部解释器是用机器码编写的，还有许多的 F-PC Forth 字为了提高执行的效率也使用机器码编写。在第七课中，我们将讨论如何编写自己的 Forth CODE 字。

由于 F-PC 使用直接串线技术，在一个 CODE 字中的机器码直接存储在代码段的 CFA 中。这里有几个 F-PC 原语定义的例子，每个字的首部与我们前面讨论的 VARIBLES ， CONSTANT 和冒号定义一样，都存储在首部段中。

3.8 Forth 字典

Forth 字典用已经定义的所有字组成为一个链表。这些字可以是变量、常数、冒号定义或者 CODE 字。所有这些字的名字都存储在首部中并通过链接字段指针方式实现连接。每个字的代码字段由首部的代码字段指针指定。代码字段总是包含真正可执行的代码，所以它必须在 8086 的 CODE 段。在一个冒号定义中，定义里的每个字的 CFA 列表存储在一个分开的列表段中，并通过存放在代码段中的 PFA 指针来指向。

当我们使用冒号定义来定义一个新字时，就包括一个把这个字存入字典的过程。 F-PC把你所定义的名字链接到一个有 64 个入口项的线索中，再使用一个散列（ HASHING）机制进行查找，以提高速度。

字典中代码段的下一个可用地址通过 HERE 指定。于是， HERE 就是一个 Forth 字，它在堆栈上返回字典空间下一个可用地址。变量 DP 称为字典指针，包含下一个可用的字典地址，字 HERE 是这样定义的：

: HERE ( -- n )

DP @ ;

(当然，F-PC 实际使用 CODE 字来定义 HERE)

引导一个 Forth 系统并出现 ok 提示符之后，你所执行的是外层解释程序。当你打入一个字并打入 <Enter> 之后，外层解释器用你输入的字查找字典。如果找到了这个字，它就执行代码字段。如果它没有找到这个字，就调用一个称为 NUMBER 的字试着把输入串转为一个数字。如果转换成功，就把这个数压入堆栈，否则，它就显示一个信息 <- What? 告诉你它不懂你输入的字。对于内层解释器的详细讨论见 3.13.

3.9 表

一个表就像是一个常数的数组。你可以创建一个数组然后使用！存储字来填充它。另一个创建表的方法是使用 Forth 字 CREATE ，它的工作方式与 VARIABLE 相同，但是不在参数字段保留空间。例如，如果你打入：

CREATE table

你就可以创建如下的字典项

和 VARIBLE 的情况一样，代码字段包含三个字节对应于指令 CALL NEXT 这里的 NEXT 是 F-PC 的内层解释器。当字 TABLE 被调用时， CALL 指令将把参数字段的地址留在堆栈上。

这里的字典指针 DP 包含表的 PFA 的值。 Forth 字 , 逗号将把堆栈上的值存储到字典指针指向的位置上，那就是字典的下一个可用位置。因此，如果你输入 CREATE table 5 , 8 , 23 , 将创建如下的字典项：

你现在可以定义一个新的字名为 @table

: @table ( ix -- n )

2* table / 2*ix pfa

+ @ ; / @(pfa + 2*ix)

例如， 2 @table 将返回 23 到栈顶。

3.10 字符和字节数据

字符 (ASCII码) 数据可以按一个字节存储。数据可以用下面的 Forth 字按单字节的方式存入和读出

C, ( c -- ) ("C-comma")

把栈顶值的低有效字节（ LSB ）存储到 HERE ( 字典的下一个可用位置 )

C! ( c addr -- ) ("C-store")

存储栈顶元素的 LSB 到 addr 位置。

C@ ( addr -- c ) ("C-fetch")

读取 addr 处的字节，把 LSB 放到堆栈上

你也可以通过下面的方式创建字节常数表而不是字常数表：

CREATE table 5 C, 8 C, 23 C,

然后你可以定义一个字 C@table

: C@table ( ix -- c )

table + C@ ;

2 C@table 将把 23 返回到栈顶

注意 C@table 和 3.9 节的 @table 定义之间的区别

3.11 查找字典地址

下面这些字可以用于定位和检查 Forth 字典项：

' ( -- cfa ) ("tick")

语句 ' table 将把 table 的 CFA 放到堆栈上。

>NAME ( cfa -- nfa ) ("to-name")

转换代码字段地址 CFA ( 在代码段中 ) 到名字字段 NFA ( 在首部段中 )

>LINK ( cfa -- lfa ) ("to-link")

转换代码字段地址 CFA ( 在代码段中 ) 到链接字段地址 LFA （在首部段中）

>BODY ( cfa -- pfa ) ("to-body")

转换代码字段地址 CFA ( 在代码段中 ) 到参数字段地址 PFA （在代码段中）

你也可以通过使用下面的字得到代码字段地址：

BODY> ( pfa -- cfa ) ("from-body")

NAME> ( nfa -- cfa ) ("from-name")

LINK> ( lfa -- cfa ) ("from-link")

你还可以从名字到链接或者从链接到名字

N>LINK ( nfa -- lfa ) ("name-to-link")

L>NAME ( lfa -- nfa ) ("link-to-name")

Forth 字 HEX 将改变用于打印输出的数基到 16 进制。字 DECIMAL 将改变数基到 10 进制，你还可以通过改变变量 BASE 的值到任何的数基。例如， HEX 是这样定义的

: HEX 16 BASE ! ;

注意，在 HEX 定义之中，数基必须是 10 进制。

Forth 字 U. 把栈顶的值作为 0 到 65535 的无符号数打，或者如果是 HEX 模式，则是 0000 到 FFFF 。作为一个例子，为了打印字 OVER 的名字字段地址，可以打入：

HEX ' OVER >NAME U. DECIMAL

Forth 字 LDUMP ( seg off #bytes -- ) 可以用于得到从 seg:off. 开始的 #bytes 个字节的存储器映像，打入

YSEG @ ' OVER >NAME 20 LDUMP

可以看到 OVER 的名字字段。 .

3.12 名字字段

如果你使用冒号来定义一个新的字，比如 TEST1 ， 将会创建以下的名字字段：

如果优先位设为 1 ，这个字将被立即执行。立即字在第 9 课中讨论。

如果使用用位为 1 ，这个字在字典搜索中不可见。这个位在冒号定义编译时设置。

输入以下的空白冒号定义：

: TEST1 ;

然后这样来检查名字字段：

YSEG @ ' TEST1 >NAME 10 LDUMP

上图的 6 个 16 理进制数将显示出来。

注意名字字希段的第 1 个和最后一个字节的最高有效位都置为 1 ，实际存储在名字字段的字符的最大数量由变量 WIDTH. 确定，例如：

10 WIDTH !

将使得名字字段最大存储 10 个字符。 F-PC 设置 WIDTH 默认值为 31 – 这是它的最大可能值。

3.13 F-PC 内层解释器操作

下图说明了 F-PC 内层解释器操作。

NEXT

LODSW ES: / Load AX with CFA at ES:SI & inc SI

JMP AX / Execute the code at the CFA in AX

NEST

XCHG BP,SP / Push IP = ES:SI

PUSH ES / on the return stack

PUSH SI

XCHG BP,SP

MOV DI,AX / AX = CFA of word to execute

MOV AX,3[DI] / Get LSO at PFA

ADD AX,XSEG / and add to XSEG

MOV ES,AX / Put this sum in ES

SUB SI,SI / Make new IP = ES:SI = ES:0

JMP >NEXT / Go to >NEST

UNNEST

XCHG BP,SP / Pop IP = ES:SI

POP SI / from the return stack

POP ES

XCHG BP,SP

JMP >NEXT / Go to >NEXT

内层解释器包含有三个子程序 NEXT、NEST和UNNEST 。一个解释指针或者叫指令指针 IP 指向 LIST 段的存储器位置，这里是下一个将要执行的字的代码段地址。在 F-PC 中，这个指令指针包含两个部分即 ES:SI 。

假设如上图所示，这个指针指向了 CUBED 定义的 SQUARED 的 CFA，子程序 NEXT 把这个 CFA 放到一个字寄存器 W 中( F-PC 中它是 AX )，并把 IP (SI)增量 2 使得它指向当前定义的下一个字( * )，然后执行 W 中的 CFA 处的代码。

这种情况下冒号定义的 CFA 处代码是一个跳转到子程序 NEST的指令，如上所示 NEST 将把 IP(ES 和 SI)压入返回堆栈使得程序在以后 UNNEST 执行时可以找到返回 CUBED 中下一个字的方法。

NEST 接着得到 LIST 段的偏移量 LSO 用于字 SQUARED ，把它加上 LIST 段的基地址 XSEG 然后把这个值存入 ES ，再把 SI 设为 0 以使得新的 IP 值为 ES:0, 它指向 SQUARED 定义的第一个字，接着再跳转到 NEXT 重复这个过程，这一次是执行 SQUARED 的第一个字 DUP 。

由于 DUP 是一个 CODE 字，它的实际的机器代码就在自己的 CFA位置，这个代码将在 NEXT 被执行的时候执行。 DUP 定义的最后一个指令是另一个跳转到 NEXT 的指令，但是现在 IP 将增量并指向了 * 的 CFA 。这又是一个 CODE 字，执行并再次跳转到 NEXT 。

冒号定义的最后一个字是 UNNEST 。当冒号字义中的分号；被执行时， UNNEST 的 CFA 被加到字典 LIST 段。 UNNEST 的代码段包含上面的机器代码，它从返回栈弹出 IP(SI 和 ES)并跳转到 NEXT 。因为这是在 SQUARED 执行时被 NEST 压入堆栈的，它指向 CUBED 定义的 SQUARED 的后一个字，这个字是 * ，就是下一个要被执行的字。

这就是 Forth 的工作方式。冒号定义作为 CFA 列表在 LIST 段中存储。当 CFA 要执行的是另一个冒号定义时， IP 被增量后压入堆栈并改变指针指向将要执行的新字定义中的第一个 CFA ，如果 CFA 是一个 CODE 字时， CFA 位置的实际机器代码被执行。这个过程在每个字结束时用一个跳转到 NEXT 的动作来持续执行。

3.14 练习

定义冒号字

: squared DUP * ;

和

: cubed DUP squared * ;

使用 F-PC 字 ' ("tick"), >LINK ("to-link"), 和 LDUMP (seg off #bytes -- ) 回答下列问题 :

1) 什么是代码段 ?CS:?

2) 什么是首部段 YSEG?

3) 什么是列表段 XSEG?

4) 什么是 squared 的 CFA?

5) 什么是 squared 的 LFA?

6) 什么是 squared 的 NFA?

7) 什么是 squared 的 PFA ?

8) 什么是 cubed 的 CFA?

9) 什么是 cubed 的 LFA?

10) 什么是 cubed 的 NFA?

11) 什么是 cubed 的 PFA?

12) 画出 squared 的首部图示并在所有的位置上标出 16 进制值。存放在 ^ CFA 位置的是什么值 ? 画出 squared 的 CFA 和 PFA 字段并给出字典的 list 段。给出字典中的所有地址值。

13) 什么是 CUBED 定义的字典的 LFA ？什么是字的名字？

14) 什么是 NEST 的地址？

15) 什么是 DUP 的 CFA?

16) 什么是 * 的 CFA?

17) 什么是 UNNEST 的地址 ?

第四课 Forth 判断

4.1 分支指令和循环

所有的计算机都必须有某种办法来产生条件分支(IF …… THEN)和实现循环， Forth 使用下面这些“良好定义”的结构：

IF ... ELSE ... THEN

DO ... LOOP

BEGIN ... UNTIL

BEGIN ... WHILE ... REPEAT

BEGIN ... AGAIN

这些语句的工作方式与它们在其它语言所表现的不同。字 IF、UNTIL 和 WHILE 运行时希望堆栈上有 true/false 标志，一个 false 标志的值是 0 ，一个 true 标志的值是 -1.

F-PC 定义两个常数

-1 CONSTANT TRUE

0 CONSTANT FALSE

标志可以通过各种方式产生，但通常的方式都是使用某些条件表达式，它们把标志留在堆栈上。

 

我们先来看看 Forth 的条件字然后给出分支和循环语句的一些例子：

4.2 条件字和true/false 标志

下面这些 Forth 条件字产生 true/false 标志 :

< ( n1 n2 -- f ) ( "less-than" )

如果 n1 小于 n2 则标志 f 为真

> ( n1 n2 -- f ) ( "greater-than" )

如果 n1 大于 n2 则标志 f 为真

= ( n1 n2 -- f ) ( "equals" )

如果 n1 等于 n2 则标志 f 为真

<> ( n1 n2 -- f ) ( "not-equal" )

如果 n1 小等于 n2 则标志 f 为真

<= ( n1 n2 -- f ) ( "less-than or equal" )

如果 n1 小于或者等于 n2 则标志 f 为真

>= ( n1 n2 -- f ) ( "greater-than or equal" )

如果 n1 大于或者等于 n2 则标志 f 为真

0< ( n -- f ) ( "zero-less" )

如果 n 小于 0 （负数）则标志 f 为真

0> ( n -- f ) ( "zero-greater" )

如果 n 大于 0 （正数）则标志 f 为真

0= ( n -- f ) ( "zero-equals" )

如果 n 等于 0 则标志 f 为真

0<> ( n -- f ) ( "zero-not-equal" )

如果 n 小等于 0 则标志 f 为真

0<= ( n -- f ) ( "zero-less-than or equal" )

如果 n 小于或者等于 0 则标志 f 为真

0>= ( n -- f ) ( "zero-greater-than or equal" )

如果 n 大于或者等于 0 则标志 f 为真

以下条件字比较堆栈上的两个无符号数

U< ( u1 u2 -- f ) ( "U-less-than" )

如果 u1 小于 u2 则标志 f 为真。

U> ( u1 u2 -- f ) ( "U-greater-than" )

如果 u1 大于 u2 则标志 f 为真。

U<= ( u1 u2 -- f ) ( "U-less-than or equal" )

如果 u1 小于等于 u2 则标志 f 为真。

U>= ( u1 u2 -- f ) ( "U-greater-than or equal" )

如果 u1 大于等于 u2 则标志 f 为真。

4.3 Forth 逻辑操作

有些 Forth 有一个字 NOT ，它可以反转堆栈上的标志值。在 F-PC 系统中，字 NOT 执行一个堆栈上的字的 1 补码。只要 TRUE 是 -1 （ 16 进制 FFFF ） , 则 NOT TRUE 就是 FALSE 。

你必须小心的是：由于任何的非 0 值都会作为 TRUE 对待，而除 16 进制 FFFF 外的任何值 进行 1 的补码运算之后都不会产生 0 （ FALSE ）。你可以使用比较字 0= 来产生标志。

除了逻辑操作符 NOT 外， Forth 也支持下列的双目逻辑操作符：

AND ( n1 n2 -- and )

在堆栈上留下 n1 AND n2 这是一个按位与运算，例如，如果你输入

255 15 AND ( mask lower 4 bits )

在栈顶将留下值 15

OR ( n1 n2 -- or )

在堆栈上留下 n1 OR n2 ，这是按位运算，例如如果你输入：

9 3 OR

将在堆栈上留下值 11

XOR ( n1 n2 -- xor )

在堆栈上留下 n1 XOR n2 ，这是按位运算，例如如果你输入

240 255 XOR ( Hex F0 XOR FF = 0F )

将在栈顶留下值 15

4.4 IF 语句

Forth 的 IF 语句与其它语言的不同。你所熟悉的一个典型 IF ... THEN ... ELSE 语句大概是这样的：

IF <cond> THEN

<true statements>

ELSE

<false statements>

而在 Forth 中， IF 语句是这样的：

<cond> IF <true statements>

ELSE <false statements>

THEN

注意，在 IF 字执行的时候， true/false 标志必须在栈顶。如果栈顶上是一个真标志，则 <true statements> 被执行，如果栈顶上是一个假标志，则 <false statements> 被执行。在 <true statements> 或者 <false statements> 被执行之后，字 THEN 后面的语句被执行。 ELSE 子句是可选的

IF 字必须在冒号定义内使用，作为一个例子，定义下列字：

: iftest ( f -- )

IF CR ." true statements"

THEN CR ." next statements" ;

 

: if.else.test ( f -- )

IF CR ." true statements"

ELSE CR ." false statements"

THEN CR ." next statements" ;

 

然后你输入：

TRUE iftest

FALSE iftest

TRUE if.else.test

FALSE if.else.test

4.5 DO 循环

Forth 的 DO 循环必须在冒号定义中使用，为了说明它是如何工作的，定义下列字：

: dotest ( limit ix -- )

DO

I .

LOOP ;

然后你输入：

5 0 dotest

值 0 1 2 3 4 将打印到屏幕上，试一下。

DO 循环是这样工作的: 字 DO 从参数栈顶上取两个值并把它们放到返回栈上。这时这两个值已经不在参数栈上了。字 LOOP 将索引值加 1 并把结果与限值进行比较。如果增量之后的索引值小于限值，则分支到 DO 下面的字。如果增量之后的索引值等于限值，则分支到 LOOP 之后的字。我们将在第九课中仔细研究 DO 循环是如何实现的。

Forth 字 I 把索引值从返回栈复制到参数栈顶。因此上面的例子可以解释如下：

5 / 5

0 / 5 0

DO

I / ix ( ix = 0,1,2,3,4)

.

LOOP

注意限值必须比你希望的最大索引值还要大 1 ，例如：

11 1 DO

I .

LOOP

将打印出值 1 2 3 4 5 6 7 8 9 10

字 +LOOP

Forth 的 DO 循环索引值可以是 1 以外的其它值，这时需要用字 +LOOP 来替代 LOOP 。 可以通过下列的例子来看工作情况：

: looptest ( limit ix -- )

DO

I .

2 +LOOP ;

然后你输入

5 0 looptest

值 0 2 4 将打印出来。

字 +LOOP 从参数栈顶取得值并把它加到返回栈的索引值中，之后的动作与 LOOP 一样，只要是增量后的索引值小于限值，它就分支到 DO 后面的语句（如果增量值为正）。如果增量的值为负，则当增量的索引值小于限值时就退出循环。例如你可以输入

: neglooptest ( limit ix -- )

DO

I .

-1 +LOOP ;

然后输入

0 10 neglooptest

值 10 9 8 7 6 5 4 3 2 1 0 将打印在屏幕上。

嵌套循环 – 字 J

Forth 的循环可以嵌套。这时就要有两对索引/限值被移到返回栈上。字 I 把内层循环的索引值从返回栈复制到参数栈上，字 J 把外层循环的索引值从返回栈复制到参数栈上。

作为一个嵌套循环的例子，定义下面的字：

: 1.to.9 ( -- )

8 1 DO

CR

3 0 DO

J I + .

LOOP

3 +LOOP ;

如果你执行这个字，下面的内容将打印到屏幕上：

1 2 3

4 5 6

7 8 9

你明白这是为什么吗？

嵌套的循环在 Forth 中比在其它高级语言中用得少。更好的办法是定义一个小的字，它只包含一个 DO 循环，然后在另外的循环中调用这个字。

字 LEAVE

Forth 字 LEAVE 可以用在 DO 循环中以退出循环。它通常是用在 DO 循环的 IF 语句中。字 LEAVE 可以立即通出 DO 循环( LOOP 之后那个字的地址作为第三个字保存在返回栈上)。还有一个相关的字 ?LEAVE (flag --) 在栈顶为真时退出 DO 循环，这就不用使用 IF 语句了。

作为一个例子，假设你想定义一个字 find.n ，它查找一个指定值在字表中的索引值（也就是这个值在表中的位置），如果找到则返回真，否则在栈顶返回假。首先用 Forth 语句构造表：

CREATE table 50 , 75 , 110 , 135 , 150 , 300 , 600 ,

将在代码段中创建表

表中值的数目是 imax ( 在我们的情况下是 7). 要查找的值是 n. 在被执行时这些值必须在堆栈是，下面是 find.n 的定义：

: find.n ( imax n -- ff | index tf )

0 SWAP ROT / 0 n imax

0 DO / 0 n

DUP I table / 0 n n ix pfa

SWAP 2* + / 0 n n pfa+2*ix

@ = / 0 n f

IF / 0 n

DROP I TRUE / 0 ix tf

ROT LEAVE / ix tf 0

THEN

LOOP / 0 n

DROP ; / 0 | ix tf

研究这个定义一直到你明白它是如何工作的时候为止。通常情况下，在使用 DO 循环时的堆栈情况在执行完 DO 时和执行室外 LOOP 时是一样的，你常常需要使用 DUP 在 DO 循环中复制值并在离开循环时用 DROP 去除一些值。特别注意 ROT 在 LEAVE 之前使用以建立堆栈以使得真标志留在堆栈顶。

4.6 UNTIL 循环

Forth 的 UNTIL 循环必须用于冒号定义中， UNTIL 循环的格式是：

BEGIN <Forth statements> <flag> UNTIL

如果 <flag> 是假，程序分支到 BEGIN 之后的字。如果 <flag> 是真 , 程序执行 UNTIL 之后的字。

下面的两个 Forth 字能够检测和读出键盘的输入

KEY? ( -- flag )

如果键盘有键按下，返回真标志。

KEY ( -- char )

等待键盘按下并将 ASCII 码返回到栈顶。

F-PC 字 EMIT ( char -- )

将在屏幕上打印栈顶 ASCII 码对应的字符。

定义下面的字

: dowrite ( -- )

BEGIN

KEY / char

DUP EMIT / print on screen

13 = / if equal to CR

UNTIL ; / quit

执行这个字将在屏幕上打印出所有你输入的字符，直到你打入了 <Enter> 键 (ASCII 码 = 13). 注意 UNTIL 从堆栈上移去标志。

4.7 WHILE 循环

Forth 的 WHILE 循环必须在冒号定义中使用， WHILE 循环的格式是

BEGIN <words> <flag> WHILE <words> REPEAT

如果 <flag> 是真，在字 WHILE 和 REPEAT 之间的字被执行，然后再分支到 BEGIN 后面的字。如果 <flag> 是假，程序分支到 REPEAT 之后的字。

作为一个例子，考虑下面求 n 阶乘的算法：

x = 1

i = 2

DO WHILE i <= n

x = x * i

i = i + 1

ENDDO

factorial = x

下面的 Forth 字计算阶乘

: factorial ( n -- n! )

1 2 ROT / x i n

BEGIN / x i n

2DUP <= / x i n f

WHILE / x i n

-ROT TUCK / n i x i

* SWAP / n x i

1+ ROT / x i n

REPEAT / x i n

2DROP ; / x

注意，为了使 WHILE 循环能够正常工作，在 BEGIN 和 REPEAT 之间的堆栈安排必须相同。还要注意的是，尽管上面的算法使用了 3 个变量 x、i 和 n ， 但 Forth 实现却不使用任何变量！这是 Forth 的特点。你可以发现在 Forth 中使用变量比在其它语言中使用变量要少得多。

可以输入以下内容测试阶乘的定义

3 factorial .

4 factorial .

0 factorial .

4.8 练习

练习 4.1 Fibonacci 序列是一个数值序列，其中的每个数（从第三个开始）都是它紧邻的前两个数之和。于是开始几个数看起来像是这样：

1 1 2 3 5 8 13 21 34

定义一个 Forth 字

fib ( n -- )

它将打印所有值小于 n 的 fibonacci 序列，通过下面方法来测试你的字：

1000 fib

练习 4.2 创建一个表称为 weights ，它包含下列值

75 135 175 115 220 235 180 167

定义一个 Forth 字称为

heaviest ( pfa -- max.value )

它将按照栈顶的值从表中打印最大值，如果你输入

weights heaviest .

值 235 将要打印出来

第五课 数

5.1 双精度数

一个双精度数是两个按 16 位方式存储在堆栈上的一个 32 位数，它的高半字在堆栈顶部 :

双精度的堆栈说明用如下方法表示

( d -- )

通过键盘输入一个双精度数时应该包含一个“小数点”，这个小数点可以在任何位置。例如你可以输入

1234.56

整数值 123456 等效于 16 进制的 1E240 ，它将按如下方式存储在堆栈上：

变量 DPL 包含有小数点的位置，在本例中是 2 。

Forth 字 D. 可以在屏幕上打印出双精度数的值。这样，如果你在 1234.56 之后输入 D. 则值 123456 将打印在屏幕上。

以下是一些双精度字：

D+ ( d d -- dsum )

加两个双精度数并保留一个双精度的和。

DNEGATE ( d -- d )

改变双精度数的符号

S>D ( n -- d )

把一个单精度数转为双精度数并进行符号扩展。

DABS ( d -- d )

得到双精度数的绝对值

D2* ( d -- d*2 )

32 位左移，相当于 d 乘 2.

D2/ ( d -- d/2 )

32 位数右移，相当于 d 除 2.

DMIN ( d1 d2 -- d3 )

d3 是 d1 和 d2 之中较小的。

DMAX ( d1 d2 -- d3 )

d3 是 d1 和 d2 之中较大的。

D- ( d1 d2 -- d1-d2 )

双精度减法留下一个双精度的差。注意： D- 的定义是

: D- DNEGATE D+ ;

?DNEGATE ( d1 n -- d2 )

如果 n < 0 则 DNEGATE d1. ，注意 ?DNEGATE 的定义是

: ?DNEGATE ( d1 n -- d2 )

0< IF

DNEGATE

THEN ;

5.2 双精度比较操作

下面是双精度比较操作的定义

: D0= ( d -- f ) / flag is TRUE if d = 0 OR 0= ;

: D= ( d1 d2 -- f ) / flag is TRUE if d1 = d2 D- D0= ;

: DU< ( ud1 ud2 -- f ) / flag is TRUE if ud1 < ud2

ROT SWAP / ud1L ud2L ud1H ud2H

2DUP U< / ud1L ud2L ud1H ud2H f

IF / ud1L ud2L ud1H ud2H

2DROP 2DROP TRUE / f

ELSE

<> / ud1L ud2L f

IF / ud1L ud2L

2DROP FALSE / f

ELSE

U< / f

THEN

THEN ;

F-PC 3.5 实际使用一个 CODE 字来定义 DU< ，它使用两个双精度的减法

: D< ( d1 d2 -- f ) / flag is TRUE if d1 < d2

2 PICK / d1L d1H d2L d2H d1H

OVER = / d1L D1H D2L D2H f

IF / d1L D1H D2L D2H

DU< / f

ELSE

NIP ROT DROP / D1H D2H

< / f

THEN ;

: D> ( di d2 -- f ) / flag is TRUE if d1 >= d2

2SWAP

D< ;

5.3 乘法和除法

基本的乘法和除法操作如下，所有的其它乘法和除法操作都是基于这些操作而实现的：

UM* ( un1 un2 -- ud )

把无符号的 16 位数 un1 与无符号的 16 位数 un2 相乘，返回 32 位的乘积 ud. 这个字使用 8088/8086 MUL 指令。

UM/MOD ( ud un -- urem uquot )

32 位的无符号整数 ud 除以 16 位的无符号整数 un 返回无符号的商和无符号的余数 urem. 这个字使用 8088/8086 DIV 指令。如果 ud 的高半字大于或者等于 un ，则商不能放入 16 位中。在这种条件下， 8088/8086 DIV 指令将产生 "Divide by zero" 异常。 Forth 字 UM/MOD 检测这种情况，在商不能放入 16 位数时返回 16 进制的 FFFF 作为商和余数。

下面的 F-PC 字将两个 16 位的有符号数相乘并留下 32 位的积。 F-PC 3.5 字义这个字为一个 CODE 字，并使用 8088/8086 IMUL 指令

: *D ( n1 n2 -- d )

2DUP XOR >R / save sign of product

ABS SWAP ABS

UM* / unsigned multiply

R> ?DNEGATE ; / fix sign

下面的 F-PC 字把一个无符号 32 位数除以一个 16 位的无符号整数，并产生一个 16 位的无符号余数和一个 32 位的无符号商。这个字没有 UM/MOD 的溢出问题。

: MU/MOD ( ud un -- urem udquot )

>R 0 R@ / udL udH 0 un

UM/MOD / udL remH quotH

R> / udL remH quotH un

SWAP >R / udL remH un

UM/MOD / remL quotL

R> ; / remL quotL quotH

5.4 向下取整的除法

以下是两个有符号除法字

/MOD ( n1 n2 -- rem quot )

M/MOD ( d n1 -- rem quot )

它们执行向下取整的除法。首先打入下面的例子来看看屏幕上将显示什么：

26 7 /MOD . .

-26 7 /MOD . .

26 -7 /MOD . .

-26 -7 /MOD . .

结果可以汇总如下：

 

你希望这样的结果吗？第二个和第三个结果可能令你奇怪，但它们却是正确的，因为我们要求的是除数乘以商加上余数等于被除数。你看：

3 * 7 + 5 = 26

-4 * 7 + 2 = -26

-4 * -7 - 2 = 26

3 * -7 - 5 = -26

这种结果称为向下取整的除法，它的特点是余数的符号与除数的符号相同，商向负无穷大方向舍入。

但是，这并不是除法的唯一运算方法。事实上， 8088/8086 的 IDIV 指令就没有使用向下取整的除法，在后一种情况下，余数的符号与被除数相同，商的大小总是相同的。

为了看这种情况，定义以下的 CODE 字并使用 IDIV 指令。

PREFIX

CODE ?M/MOD ( d n1 -- rem quot )

POP BX

POP DX

POP AX

IDIV BX

2PUSH

END-CODE

现在输入 ( 注意在 26 的后面输入一个点以保证它是一个双精度数 )

26. 7 ?M/MOD . .

-26. 7 ?M/MOD . .

26. -7 ?M/MOD . .

-26. -7 ?M/MOD . .

新的结果如下

注意在这种情况下，除数乘以商加上余数仍然等于被除数。尽管你可能喜欢这种除法而不喜欢向下取整除法，但是向下取整除法可以解决舍入到 0 的不确定问题。输入以下内容

向下取整除法

3 4 /MOD . . 0 3

-3 4 /MOD . . -1 1

3 -4 /MOD . . -1 -1

-3 -4 /MOD . . 0 -3

非向下取整除法

3 4 ?M/MOD . . 0 3

-3 4 ?M/MOD . . 0 -3

3 -4 ?M/MOD . . 0 3

-3 -4 ?M/MOD . . 0 -3

我们可以看到非向下取整除法不能区别 3 4 ?M/MOD 和 3 -4 ?M/MOD ，也不能区别 -3 4 ?M/MOD 和 -3 -4 ?M/MOD.

这里是 M/MOD 的定义方法

: M/MOD ( d n -- rem quot )

?DUP / return d if n = 0

IF / dL dH n

DUP >R / save n

2DUP XOR >R / save sign

>R / dL dH

DABS R@ ABS / |dL dH| |n|

UM/MOD / urem uquot

SWAP R> / uquot urem n

?NEGATE / uquot rem (sign=divisor)

SWAP R> / rem uquot xor

0<

IF / rem uquot

NEGATE / rem quot

OVER / rem quot rem

IF / rem quot

1- /floor quot toward - infinity

R@ / rem quot n

ROT - / quot floor.rem = n - rem

SWAP / rem quot

THEN

THEN

R> DROP

THEN ;

于是 /MOD 就可以这样定义

: /MOD ( n1 n2 -- rem quot )

>R S>D R>

M/MOD ;

F-PC 实际定义 /MOD 成一个 CODE 字，它使用 IDIV 并接着进行余数和商的向下取整。

5.5 16 位操作

下面给出一些 16 位的操作字是如何定义的，这些字都对 16 位数进行算术操作并保留 16 位的结果。实际上， F-PC 也定义了这些字的等效 CODE 字以提高执行速度。

: * ( n1 n2 -- n ) / signed multiply

UM* DROP ;

也可能有些奇怪，但是事实上却是只要你丢弃一个无符号 32 位集的高位字，你就可以得到正确的 16 位结果。当然，积必须在 -32768 到 +32767 之间

: / ( n1 n2 -- n ) / signed division

/MOD NIP ;

: MOD ( n1 n2 -- rem )

/MOD DROP ;

: */MOD ( n1 n2 n3 -- rem n1*n2/n3 )

>R / n1 n2

*D / n1*n2 (32-bit product)

R> / n1*n2 n3

M/MOD ; / rem quot

注意商等于 n1*n2/n3 ，这里中间积的结果是一个 n1*n2 的 32 位数

: */ ( n1 n2 n3 -- n1*n2/n3 )

*/MOD NIP ;

如果你希望 n1*n2/n3 舍入到一个整数，我们可以写

n1*n2/n3 = Q + R/n3

这里 Q 是商， R 是余数。为了进行舍入我们把结果的小数部分加上 1/2

n1*n2/n3 = Q + R/n3 + 1/2

我们可以写作

n1*n2/n3 = Q + (2*R + n3)/2*n3

我们接着可以定义 */R 以计算 n1*n2/n3 合入 :

: */R ( n1 n2 n3 -- n1*n2/n3 rounded )

DUP 2SWAP / n3 n3 n1 n2

ROT / n3 n1 n2 n3

*/MOD / n3 R Q

-ROT 2* / Q n3 2*R

OVER + / Q n3 2*R+n3

SWAP 2* / Q 2*R+n3 2*n3

/ + ;

5.6 双精度数的乘法

有时我们需要把一个双精度数 (32 位 ) 与一个 16 位相乘并得到双精度结果。当然在通常的情况下，如果你用一个 32 位数乘以 16 位数，你最大可以得到 48 位的结果。然而，在许多情况下，你又可以知道尽管最终的结果多于 16 位但不可能多于 32 位。

假设 A, B, C, D, E, F 和 G 都是 16 位数。我们可以把 32 位数 A:B 乘以 16 位数 C 的结果表示如下

A B

  C

X

___________________________

D E

   G F

___________________________

pH pL

在上面的图中， B 乘以 C 给出 32 位结果 D:E ， A 乘以 C 给出 32 位结果 G:F. 把这两部分积按图所不移位相加，得到完整的 48 位积。不过我们想去除 G 以把结果限于 32 位。这个积的低半字是 pL = E ，而高半字是 pH = D + F. 于是我们可以这样定义这个乘法

: DUM* ( ud un -- ud )

DUP / B A C C

ROT / B C C A

* / B C F

-ROT / F B C

UM* / F E D

ROT / E D F

+ ; / pL pH

5.7 练习

一个图像系统使用摄像机测量一个轴承滚珠的体积。这个系统以像素为单位测试轴承滚珠的直径。对应直径的最大像素数目为 256. 系统经过调整后， 100 像素对应 1 厘米。使用这种系统被测量的轴承滚珠直径从 0.25 到 2.5 cm.

编写一个 Forth 字称为 VOLUME ，它使用堆栈上的以像素为单位的直径计算轴承滚珠的体积，舍入到最近的立方厘米并把结果放到堆栈上。

注意：球的体积是 (4/3)*pi*R**3 这里 R 是半径，而 PI 可以近似到（小数点 7 位） 355/113.

使用以下直径来测试程序

25 50 100 150 200 250

第六课 字符串

6.1 字符串输入

如果需要从终端接收字符串并把它放到 addr 开始的缓冲区中，可以使用字：

EXPECT ( addr len -- )

这个字具有有限的编辑能力(例如，你可以使用 backspace 来回退)，并且还可以存储你连续键入的 ASCII 码，直到你输入了 len 个字符或者输入了一个回车，输入的字符数量存储在变量 SPAN 中。

终端输入缓冲区的地址存储在变量 #TIB 中，字

TIB ( -- addr )

把这个地址放到栈顶。

字 QUERY 从键盘输入一个串并把它存储到终端输入缓冲区中，它可以用以下方法定义：

: QUERY ( -- )

TIB 80 EXPECT

SPAN @ #TIB !

>IN OFF ;

变量 #TIB 包含 TIB 中的字符数量。变量 >IN 是一个指向 TIB 中字符的指针，它被字 OFF 初始化到 0.

假设你对字 QUERY 输入了以下字符并按下了 <Enter>.

3.1415,2.789

这些字符的每一个 ASCII 码都将存储到终端输入缓冲区中，其地址存储在 TIB 中。值 12 将存储在变量 #TIB 中。

现在，假设你想分析输入流并得到用逗号分开的两个数，你可以使用这个字

WORD ( char -- addr )

它将分析输入流并寻找字符 char， 之后，留下一个“计数串”在addr 位置 ( 这实际是地址 HERE)。 这样，如果你输入了一个下面这样的短语 ：

ASCII , WORD

字 ASCII , 将把逗号的 ASCII 码 (hex 2C) 放到堆栈上，接着字 WORD 将在 HERE 处存储以下结果

注意,第一个字节是一个计数字节，它指出包含在一个串中的字节数量(这里是 6 )，另外字 WORD 将把在串之后放一个空格

这时变量 >IN 将指向逗号之后的字符(这里是 2)。下一次再调用短语：

ASCII , WORD

则计数串“2.789”将存储到 HERE 。尽管这次在串的结束处没有找到逗号，但是字 WORD 在没有找到字符 char 时将一直找到串和结尾。

6.2 ASCII – 二进制转换

假设你输入了数字 3.1415. 我们在第五课里已经看到如果你做这件事的时候处于解释模式，则值 31415 将作为一个双精度数放在堆栈上，相对右边的小数点的位置(4)放在变量 DPL中。

如何在自己的程序中做这件事情呢？比如，你想让用户输入数字并最后把数放到堆栈上。 Forth 字 NUMBER 将转换 ASCII 串成为二进制数。堆栈说明是这样的：

NUMBER ( addr -- d )

这个字将转换位于addr处的一个计数串并把结果作为一个双精度数放到堆栈上。串可以表示成一个当前数字基的实数，有一个小数点的有符号数，小数点之后的数字数目存储在变量 DPL 中，如果没有小数则 DPL 的值是 -1. 数字串必须由一个空格结束，这也正好符合字 WORD 的条件。

如果我们希望从键盘输入一个数(16 位)，我们就可以定义以下的字：

: enter.number ( -- n )

QUERY

BL WORD

NUMBER DROP ;

在这个定义中， BL 是空格的 ASCII 码(ASCII 20H)。于是，字 WORD 将分析输入串直到一个空格或者到串的结尾。NUMBER 把输入串转换成为一个双精度数， DROP 丢弃高位字并在堆栈上留下一个单精度结果。注意，这个值必须在 -32768 到 32767 之间，这样双精度数的高位字为 0 (于是我们才可以简单地使用丢弃高位字的方法)。

6.3 数值输出转换

为了在屏幕上打印出数 1234，我们必须这样做：

1) 用数基来除这个数

2) 把余数转为 ASCII 码并作为一个数字串反向存储

3) 重复 1) 和 2) 直到余数为 0

例如 ：

1234/10 = 123 Rem = 4

123/10 = 12 Rem = 3

12/10 = 1 Rem = 2

1/10 = 0 Rem = 1

下面的 Forth 字用于实现转换并在屏幕上打印结果

PAD 是一个位于 HERE 之上的 80 个字符的临时缓冲区

: PAD ( --- addr )

HERE 80 + ;

HLD 是一个变量，它指示存储在数字串中的最后一个字符

<# 开始数字转换并把数字串存储在 PAD 之下

: <# ( -- )

PAD HLD ! ;

HOLD 把字符 char 搬进输出串

: HOLD ( char -- )

-1 HLD +!

HLD @ C! ;

Forth 字 ! ( n addr -- ) 把 addr 位置的值加 n 。这样， 在HOLD 定义中， HLD 的值就减了 1 ，然后与 char 对应的ASCII 码就被存储到 HLD 字节位置。

F-PC 有两个 CODE 字 INCR ( addr -- ) 和 DECR ( addr -- ), 将增量和减量 addr 的内容，例如

HLD DECR 等效于 -1 HLD +!

INCR 等效于 1 SWAP +!.

字 # ( 读作 "sharp") 通过执行上面的 1) 和 2) 转换后面的字符。被除数必须是一个双精度数。

: # ( d1 -- d2 )

BASE @ MU/MOD / rem d2

ROT 9 OVER / d2 rem 9 rem

<

IF / if 9 < rem

7 + / add 7 to rem

THEN

ASCII 0 + / conv. rem to ASCII

HOLD ; / insert in string

字 #S ( 读作 "sharp-S") 转换其它的双精度数并在堆栈上留下一个 0

: #S ( d -- 0 0 )

BEGIN

# / convert next digit

2DUP OR 0= / continue until

UNTIL ; / quotient = 0

字 #> 完成转换，它的作用是：丢弃 #S 留下的双精度 0 ，计算串的长度，用最后一个字符的地址(PAD)减第一个字符地址（现在存储在 HLD 中），这个长度放到堆栈上面，而它的下面是串地址( 在 HLD 中 ).

: #> ( d -- addr len )

2DROP / drop 0 0

HLD @ / addr

PAD OVER / addr pad addr

- ; / addr len

Forth 字 SIGN 用于判断堆栈上的数是不是负数，如果是，则在输出串中插入一个减号（ -)

: SIGN ( n -- )

0<

IF

ASCII - HOLD

THEN ;

这些字将在下面部分中用于在屏幕上显示数值。

6.4 屏幕输出

字 TYPE 打印一个串，它的地址和长度都在栈顶，可以如下定义：

: TYPE ( addr len -- )

0 ?DO / addr

DUP C@ / addr char

EMIT 1+ / next.addr

LOOP

DROP ;

F-PC 实际使用一个有些不同的定义 TYPEL ，它允许你打打印存储在任何段中的串。在 F-PC 3.5 之前你必须把段地址存储器在变量 TYPESEG 中，而在 F-PC 3.5中不再需要（甚至不再允许）。

现在你使用字

TYPEL ( seg addr len -- )

来打印长度为 len 存储在 seg:addr 的字符串。

字符串通常使用下列三种方式之一来指定：

(1) 计数串的第一个字节包含有串的字符数。这种串通过给出其计数字节的地址来指定 ( addr -- ).

(2) 通过给出第一个字节的地址和长度来指定 ( addr len -- ).

(3) 一个 ASCIIZ 串通过给出第一个字符的地址来指定 ( addr -- ). 串的结束标志是一个 nul 字符 ( 一个值为 0 的字节 ).

Forth 字 COUNT 可以把一个计数串 (1) 转换成地址 - 长度串 (2) ，字

COUNT ( addr -- addr+1 len )

得到一个计数串的地址 (addr) 并留下第一个字符的地址和串的长度（这个长度是从 addr 处的字节中得到的）。

由于 TYPE 要求串的地址和长度放在栈上，为了打印计数串你必须使用

COUNT TYPE

例如 : 下面这个字可以在屏幕上打印你输入的任何内容（注意： 13 是回车键的 ASCII 码）

: echo ( -- )

QUERY / get a string

13 WORD

CR COUNT TYPE ;

6.3 节中的数值输出转换字的使用可以通过下面这些字来解释

字 (U.) 转换一个无符号数并把转换之后得到的串的地址和长度放到堆栈上。

: (U.) ( u -- addr len )

0 <# #S #> ;

字 U. 打印这个串并后随一个空格

: U. ( u -- )

(U.) TYPE SPACE ;

字 SPACE 打印一个空格

: SPACE ( -- )

BL EMIT ;

这里 BL 是 CONSTANT 32, 也就是空格的 ASCII 码

Forth 字 SPACES ( n -- ) 打印 n 个空格

当我们要在屏幕上按列方式打印数字时，需要在一个宽度为 wid 的字段中进行右对齐打印。这可以通过对一个无符号数用 Forth 字 U.R 实现。

: U.R ( u wid -- )

>R (U.) / addr len

R> / addr len wid

OVER - SPACES / addr len

TYPE ;

例如， 8 U.R 将打印一个无符号数，在一个宽度为 8 的字段中右对齐。

为了打印有符号数，当这个数为负时我们需要在串的开始时插入一个减号。字 (.) 做这件事：

: (.) ( n -- addr len )

DUP ABS / n u

0 <# #S / n 0 0

ROT SIGN #> ;

点 (.) 定义如下

: . ( n -- )

(.) TYPE SPACE ;

字 .R 可以用于打印一个有符号数，并在宽度为 wid 的字段中右对齐：

: .R ( n wid -- )

>R (.) / addr len

R> / addr len wid

OVER - SPACES / addr len

TYPE ;

类似字用于打印无符号数和有符号数

: (UD.) ( ud -- addr len )

<# #S #> ;

: UD. ( ud -- )

(UD.) TYPE SPACE ;

: UD.R ( ud wid -- )

>R (UD.) / addr len

R> / addr len wid

OVER - SPACES / addr len

TYPE ;

: (D.) ( d -- addr len )

TUCK DABS / dH ud

<# #S ROT SIGN #> ;

: D. ( d -- )

(D.) TYPE SPACE ;

: D.R ( ud wid -- )

>R (D.) / addr len

R> / addr len wid

OVER - SPACES / addr len

TYPE ;

如果希望清除屏幕，使用字

DARK ( -- )

在屏幕上设置光标位置，可以使用字

AT ( col row -- )

例如，下面的 Example_6.4 将清除屏幕并打印信息“Message starting at col 20, row 10”.

: Example_6.4 ( -- )

DARK

20 10 AT

." Message starting at col 20, row 10"

CR ;

第七课 CODE 字和 DOS I/O

7.1 CODE 字

当我们需要最大的执行速度或者需要直接访问计算机硬件时，可以用汇编语言来定义 Forth 字。这需要使用 Forth 字 CODE 来完成。 CODE 的一般格式是：

CODE <name>

<assembly commands>

<return command>

END-CODE

字 CODE 代替冒号定义的冒号，并建立一个 Forth 字的头，END-CODE 代替分号结束 CODE 字的定义。

<assembly commands> 可以用 POSTFIX （后缀）也可以用 PREFIX 前缀格式来编写。我们建议使用 PREFIX 前缀格式，这样汇编语言就和标准的 8086/8088 汇编语言相似了，于是在 CODE 编译之前，需要给出字 PREFIX 。

<return command> 可以是下面这些指令中的任何一个：

NEXT JMP >NEXT ( jumps to the inner interpreter >NEXT )

1PUSH PUSH AX

JMP >NEXT ( pushes ax on the stack and jumps to >NEXT )

2PUSH PUSH DX

PUSH AX ( pushes dx and ax on the stack

JMP >NEXT and then jumps to >NEXT )

调试 CODE 字时可以使用 8088 Tutor monitor, 它包含在本教程中。 Tutor monitor 使用 8086 汇编语言，学习 8088/8086 汇编语言的书可以参看

"IBM PC - 8088 Assembly Language Programming" by Richard E. Haskell.

作为一个使用 Tutor monitor 反汇编和单步执行 CODE 字的例子，可以用 F-PC 3.5 提供的字 CMOVE ，它从地址 <source> 移动 <count> 字节到地址 <dest>，并假设状态寄存器的方向标志是 0 （通过执行 CLD 指令） 所以字符串原语 MOVSB 将自动增量 SI 和 DI.

CODE CMOVE ( source dest count -- )

MOV BX, SI / save SI (IP)

MOV AX, DS / copy DS for setting ES

POP CX / cx = count

POP DI / di = destination address

POP SI / si = source address

MOV DX, ES / save es in dx

MOV ES, AX / point es to code segment

REPNZ / repeat until count is zero

MOVSB / copy DS:SI to ES:DI

MOV SI, BX / restore si

MOV ES, DX / restore es

NEXT / done, jmp to >NEXT

END-CODE

当你装入这个代码后， 16 进制值 11 22 33 44 55 在偏移地址在source.addr的代码段，代码段的实际值由 Forth 字 ?CS: 给出，使用字 show.addrs 可以打印到屏幕上。

在偏移量dest.addr" 地址处保留 5 个字节的空间，当你打入字 show.addrs 后，偏移地址 source.addr, dest.addr, 栈顶元素， CMOCE 的 CFA 也被印到屏幕上。

HEX

CREATE source.addr 11 C, 22 C, 33 C, 44 C, 55 C,

CREATE dest.addr 5 ALLOT

5 CONSTANT #bytes

: test ( -- )

source.addr dest.addr #bytes CMOVE ;

: show.addrs ( -- )

HEX

CR ." code segment = " ?cs: u.

CR ." source addr = " source.addr u.

CR ." dest addr = " dest.addr u.

CR ." top of stack = " SP0 @ U.

CR ." address of CMOVE = " [ ' CMOVE ] LITERAL U.

CR DECIMAL ;

字 [, ] 和 LITERAL 将在第九课讨论。

假设被 "show.addrs" 打印的值如下

code segment = 1091

source addr = 74E0

dest addr = 74E8

top of stack = FFE2

address of CMOVE = 477

你的值可能不同，如果不同，则在下面的练习中你应该使用对应的实际值。

Type debug test.

Type HEX

Type test.

单步通过前三个字，它们将打印下面的堆栈值：

74E0 74E8 5

Press F to go to Forth.

Type SYS TUTOR – 将执行 TUTOR 程序

通过 TUTOR 存储器显示

Type >S1091 to display the code segment.

Type /GS1091 to display the data segment = code segment.

Type /GOFEDC to display the stack starting at the top of the

stack (FEE2) minus 6 in the data segment region. The

value 5 (05 00) should be on top of the stack, followed

by the "source addr" 74E0 (E0 74) and the "dest addr"

74E8 (E8 74).

Type /GO74E0 to display the "source addr" in the data segment.

Note that 11 22 33 44 55 is displayed.

Type >O477 to go to the start of the CMOVE code.

再次按 F1 单步执行前两个指令。注意 SI 的值被移到 BX 而 DS 的值被移到 AX 。下一个指令是 POP CX ，它假设从栈顶弹出了 #bytes (5) 值到 CX 。然而， Tutor 的堆栈指针和堆栈段寄存器并没有指向这些值，我们实际看它们在 1091:FEDC. 你可以改变 SS 和 SP 的值，通过打入 /RSS1091 使堆栈段和代码段相同，打入 /RPSFEDC 使堆栈指针等于栈顶 (FFE2) 减 6 。

接着按 F1 执行 POP CX，不过，你又会遇到一个问题，这就是就如何回到 F-PC 。当你退出 Tutor 时你也许退到了 DOS ，或者也可能计算机挂起了。一个变通的办法是用手工方法装入适当的值 5 到 CX 。输入 /RGC5 ，然后按右光标键跳过指令 POP CX 。

使用同样方法跳过指令 POP DI，通过手工输入 /RID74E8 装入dest addr 。

使用同样方法跳过指令 POP SI，通过手工输入 /RIS74E0 装入source addr。

你可以按两次 F1 执行下面两个指令。

你现在位于 REP 指令，按 F1 。注意到值 11 从数据段地址 74E0 复制到扩展段(它实际上与数据段一致)地址 74E8 ，并且 SI 和 DI 都增加了1. 这是指令 MOVSB 的工作 – 它也只做这些。同时 CX 从 5 减量到 4 。

再按 F1 。注意 22 从 SI 所指示的数据段位置（ (74E1) 移动到 DI 所指示的扩展段位置 (74E9) ， CX 的值 减量到 3

按 F1 三次则值 33 44 和 55 被移动，注意当 CX 为 0 时， REP 循环终止，下一条指令准备执行。

按 F1 两次，执行下面两条指令。下面的指令是一个 JMP 指令，它跳转到 >NEXT.

要退出 TUTOR, 批入 /QD. 这会返回到你在 Forth 中你打入 sys tutor 命令的地方。打入 <Enter> 返回到调试模式，打一个空格键你就可以回到 Forth 。

Forth 字 CMOVE> ( source dest count -- ) 与 CMOVE 类似，差异是字节按相反的方向移动。也就是说，最高地址的字节先移动。在向上移动字符串时这个功能很有用，因为字符串可能重叠，如果这时使用CMOVE则可能导致源串还没有移动之前就已经被破坏了。

7.2 CODE 条件

当我们使用 Forth 汇编的跳转指令时， Forth 字 IF ... ELSE ... THEN 、 BEGIN ... WHILE ... REPEAT 和 BEGIN ... UNTIL 可以有下列的代码条件

0= JNE/JNZ

0<> JE/JZ

0< JNS

0>= JS

< JNL/JGE

>= JL/JNGE

<= JNLE/JG

> JLE/JNG

U< JNB/JAE/JNC

U>= JB/JNAE/JC

U<= JNBE/JA

U> JBE/JNA

OV JNO

CX<>0 JCX0

作为一个例子，考虑 Forth 字 ?DUP 的定义，它只在堆栈上的值为非 0 时才复制栈顶：

CODE ?DUP ( n -- n n | 0 )

MOV DI, SP

MOV CX, 0 [DI]

CX<>0

IF

PUSH CX

THEN

NEXT

END-CODE

注意当这个定义汇编后，语句 CX<>0 被汇编成 JCX0 放在 THEN.

7.3 长存储器地址字

下面这些长存储器地址字对于访问不在代码段的数据非常有用：

CODE @L ( seg off -- n ) / Fetch 16-bit value from seg:off

POP BX / BX = offset address

POP DS / DS = segment address

MOV AX, 0 [BX] / AX = data at DS:BX

MOV BX, CS / Restore DS to CS value

MOV DS, BX

1PUSH / push value on stack

END-CODE

CODE !L ( n seg off -- ) / Store 16-bit value at seg:off

POP BX / BX = offset address

POP DS / DS = segment address

POP AX / AX = n

MOV 0 [BX],AX / Store n at DS:BX

MOV BX, CS / Restore DS to CS value

MOV DS, BX

NEXT

END-CODE

下面是一些有用的长存储器字：

C@L ( seg off -- byte ) / Fetch 8-bit byte from seg:off

C!L ( byte seg off -- ) / Store 8-bit byte at seg:off

CMOVEL ( sseg soff dseg doff count )

/ move a block of count bytes from sseg:soff to dseg:doff

CMOVEL> ( sseg soff dseg doff count )

/ move a block of count bytes from sseg:soff to dseg:doff

/ moves last byte first to avoid overwriting moved data

7.4 DOS 字

F-PC 拥有大量的 Forth 字用于处理 DOS 文件 I/O ，这些字都在源文件 HANDLES.SEQ 和 SEQREAD.SEQ 中定义。本节和下面一节将开发一系列的文件 I/O 字，它们可以让你使用并扩展处理各种文件 I/O 、进行其它 DOS 操作。这些字可以替代或者与 F-PC DOS 和文件 I/O 字联合使用。

VARIABLE ITEMS / used to record stack depth

VARIABLE handl / file handle

VARIABLE eof / TRUE if end-of-file was read

CREATE fname 80 ALLOT / 80 byte buffer containing ASCII filename

: {{ ( -- )

DEPTH ITEMS ! ;

: }} ( -- c )

DEPTH ITEMS @ - ;

{{ . . . }} 使用追踪放置到堆栈上的元素的数目，例如：

{{ 5 2 8 }}

将把下列值留在堆栈上

5 2 8 3

堆栈上的3是在 {{ 和 }} 之间的元素的数目。

: $>asciiz ( addr1 -- addr2 ) / change counted string to ASCIIZ string

DUP C@ SWAP 1+

TUCK +

0 SWAP C! ;

DOS 2.0+ 磁盘 I/O 功能

2fdos 调用 DOS INT 21H 功能，并使用堆栈上的 ax =ah:al, bx, cx 和 dx 。它在堆栈上返回 ax, dx 和一个错误标志。如果错误标志为真，则错误代码在 ax 中（堆栈上的第三个元素）。如果错误标志为假，则 ax 和 dx 的值依赖于所调用的功能。

fdos 与 2fdos 相似，但是不返回错误标志，它被用于不使用进位标志来指示错误的功能调用。

PREFIX

HEX

CODE 2fdos ( ax bx cx dx -- ax dx f )

POP DX

POP CX

POP BX

POP AX

INT 21 / DOS function call

U>=

IF / if carry = 0

MOV BX, # FALSE / set error flag to false

ELSE / else

MOV BX, # TRUE / set error flag to true

THEN

PUSH AX

PUSH DX

PUSH BX

NEXT

END-CODE

CODE fdos ( ax bx cx dx -- ax dx )

POP DX

POP CX

POP BX

POP AX

INT 21 / DOS function call

PUSH AX

PUSH DX

NEXT

END-CODE

DECIMAL

7.5 基本的文件 I/O

下面这些字可以用于基本的文件 I/O 操作，比如打开、创建、关闭和删除文件，以及从磁盘文件中读写字节。

open.file ( addr -- handle ff | error.code tf )

打开一个文件。在栈顶的假标志下返回一个句柄，在真标志下返回一个错误代码。 addr 指向一个 asciiz 串，访问码设为 2 用于读写方式读写。

HEX

: open.file ( addr -- handle ff | error.code tf )

3D02 / ah = 3D; al = access.code=2

0 ROT 0 SWAP / 3D02 0 0 addr

2fdos / DOS function call

NIP ; / nip dx

close.file 关闭一个文件，文件句柄在栈顶，如果不能关闭则打印错误信息。

: close.file ( handle -- )

3E00 / ah = 3E

SWAP 0 0 / bx = handle

2fdos

NIP / nip dx

IF

." Close error number " . ABORT

THEN

DROP ;

create.file 创建文件 – 返回值与 open.file 一样

addr 指向一个 asciiz 串

attr 是文件属性

0 - normal file

01H - read only

02H - hidden

04H - system

08H - volume label

10H - subdirectory

20H – archive

: create.file ( addr attr -- handle ff | error.code tf )

3C00 / ah = 3C

0 2SWAP SWAP / 3C00 0 attr addr

2fdos

NIP ; / nip dx

open/create 在文件存在就打开它，不存在时则创建一个新的一般文件

addr 指向一个 asciiz 串，返回一个打开文件的句柄，如果不能打开则打印一个错误信息。

: open/create ( addr -- handle )

DUP open.file

IF

DUP 2 =

IF

DROP 0 create.file

IF ." Create error no. " . ABORT

THEN

ELSE

." Open error no. " . DROP ABORT

THEN

ELSE

NIP

THEN ;

: delete.file ( addr -- ax ff | error.code tf )

4100

0 ROT 0 SWAP

2fdos

NIP ;

: erase.file ( $addr -- )

$>asciiz

delete.file

IF

CR ." Delete file error no. " .

ELSE

DROP

THEN ;

read.file 从文件 handle 中读出 #bytes 个字节到 buff.addr 缓冲区，返回读入的字节数 #bytes ，如果返回 0 ，则读到了文件尾，如果不成功则打印错误信息。

: read.file ( handle #bytes buff.addr -- #bytes )

>R 3F00 / handle #bytes 3F00

-ROT R> / 3F00 handle #bytes addr

2fdos

NIP / nip dx

IF

." Read error no. " . ABORT

THEN ;

write.file 将 buff.addr' 绘缓冲区的 '#bytes' 个字节写入文件 'handle'. 如果不成功则打印一个错误信息。

: write.file ( handle #bytes buff.addr -- )

>R 4000 / handle #bytes 4000

-ROT R> / 4000 handle #bytes addr

2fdos

NIP / nip dx

IF

." Write error no. " . ABORT

ELSE

DROP

THEN ;

mov.ptr 移动文件 handle 的文件读写指针，doffset 是一个双精度 32 位偏移量，code 是方式代码，其意义如下：

0 – 移动文件指针到文件开始 + offset 处

1 – 用 offset 增量指针

2 - 移动文件指针到文件尾 + offset 处

: mov.ptr ( handle doffset code -- dptr )

42 FLIP + / hndl offL offH 42cd

ROT >R / hndl offH 42cd

-ROT R> / 42cd hndl offH offL

2fdos

IF

DROP ." Move pointer error no. " . ABORT

THEN ;

rewind.file 移动文件 handle 的读写指针到文件开始处

: rewind.file ( handle -- )

0 0 0 mov.ptr 2DROP ;

get.length 返回文件 handle 的 32 位字节长度

: get.length ( handle -- dlength )

0 0 2 mov.ptr ;

read.file.L 从已经打开的文件 handle 中读出 #bytes 字节到扩展存储器 seg:offset 处

CODE read.file.L ( handle #bytes seg offset -- ax f )

POP DX

POP DS

POP CX

POP BX

MOV AH, # 3F

INT 21

U>=

IF

MOV BX, # FALSE

ELSE

MOV BX, # TRUE

THEN

MOV CX, CS / restore DS

MOV DS, CX

PUSH AX

PUSH BX

NEXT

END-CODE

write.file.L 写 #bytes 个字节到一个打开的文件 handle 中，要写入的数据在扩展存储器 seg:offset 处。

CODE write.file.L ( handle #bytes seg offset -- ax f )

POP DX

POP DS

POP CX

POP BX

MOV AH, # 40

INT 21

U>=

IF

MOV BX, # FALSE

ELSE

MOV BX, # TRUE

THEN

MOV CX, CS / restore DS

MOV DS, CX

PUSH AX

PUSH BX

NEXT

END-CODE

findfirst.dir 查找文件目录的第一个匹配，文件指示符位于 addr 的 asciiz 串。

CODE findfirst.dir ( addr -- f ) / search directory for first match

POP DX / dx = addr of asciiz string

PUSH DS / save ds

MOV AX, CS

MOV DS, AX / ds = cs

MOV CX, # 10 / attr includes subdirectories

MOV AX, # 4E00 / ah = 4E

INT 21 / DOS function call

JC 1 $ / if no error

MOV AX, # FF / flag = TRUE

JMP 2 $ / else

1 $: MOV AX, # 0 / flag = FALSE

2 $: POP DS / restore ds

PUSH AX / push flag on stack

NEXT

END-CODE

findnext.dir 查找文件目录的下一个匹配，文件描述在 addr 处

CODE findnext.dir ( -- f ) / search directory for next match

PUSH DS / save ds

MOV AX, CS

MOV DS, AX / ds = cs

MOV AX, # 4F00 / ah = 4F

INT 21 / DOS function call

JC 1 $ / if no error

MOV AX, # FF / flag = TRUE

JMP 2 $ / else

1 $: MOV AX, # 0 / flag = FALSE

2 $: POP DS / restore ds

PUSH AX / push flag on stack

NEXT

END-CODE

set-dta.dir 设置磁盘传输区 DTA 地址

CODE set-dta.dir ( addr -- ) / set disk transfer area address

POP DX / dx = dta address

PUSH DS / save ds

MOV AX, CS

MOV DS, AX / ds = cs

MOV AX, # 1A00 / ah = 1A

INT 21 / DOS function call

POP DS / restore ds

NEXT

END-CODE

DECIMAL

7.6 读入数和字符串

下面的字可以用于从磁盘文件中读入字节、数和串。

get.fn 从键盘输入一个文件名并作为一个 asciiz 串存放 fname 中。

: get.fn ( -- )

QUERY BL WORD / addr

DUP C@ 1+ / addr cnt+1

2DUP + / addr len addr.end

0 SWAP C! / make asciiz string

SWAP 1+ SWAP / addr+1 len

fname SWAP / from to len

CMOVE ;

open.filename 输入一个文件名，打开这个文件，将文件句柄存入变量 handl 中。

: open.filename ( -- )

get.fn

fname open/create

handl ! ;

eof? 如果读到了一个文件结束符(eof = true)，则退出包含 eof? 的这个字。

: eof? ( -- )

eof @

IF

2R> 2DROP EXIT

THEN ;

get.next.byte 从磁盘文件中得下一个字节，文件句柄在 handl 中，如果是 eof 则设置变量 eof 为真。

: get.next.byte ( -- byte )

handl @ 1 PAD read.file

IF

FALSE eof ! PAD C@

ELSE

TRUE eof !

THEN ;

get.next.val 从文件中读出下一个字的值(2 字节)，文件句柄在 handl 中，如果到达文件尾则设置变量 eof 为真，如果文件中存储的不是 ASCII 码而是实际的数则这个字就非常有用。

: get.next.val ( -- n )

handl @ 2 PAD read.file

IF

FALSE eof ! PAD @

ELSE

TRUE eof !

THEN ;

get.next.dval 从磁盘文件中读入 32 位的值(4 字节)，文件句柄在 handl 中。如果文件结束则则设置 eof 变量为真，如果文件中存储的不是 ASCII 码而是实际的数则这个字就非常有用。

: get.next.dval ( -- d )

handl @ 4 PAD read.file

IF

FALSE eof ! PAD 2@

ELSE

TRUE eof !

THEN ;

parenchk 如果栈上是一个 '(' 则读文件直到字符 ')' 被读入。如果 eof 则退出。

: parenchk ( byte -- byte )

DUP ASCII ( =

IF

DROP

BEGIN

get.next.byte eof?

ASCII ) =

UNTIL

get.next.byte eof?

THEN ;

quotechk 如果堆栈上的字节是引号 (") ，读入文件直到字节 " 被读入。如果读到 eof 则退出。

: quotechk ( byte -- byte )

DUP ASCII " =

IF

DROP

BEGIN

get.next.byte eof?

ASCII " =

UNTIL

get.next.byte eof?

THEN ;

?digit 检查堆栈上的字节是不是一个对应当前数基的 ASCII 码。

: ?digit ( byte -- byte f )

DUP BASE @ DIGIT NIP ;

get.next.digit 从磁盘文件中得到一个合法的 ASCII 数字，如果读到 eof 则退出。

: get.next.digit ( -- digit )

BEGIN

get.next.byte eof?

parenchk eof?

quotechk eof?

?digit NOT

WHILE

DROP

REPEAT ;

get.digit/minus 从磁盘文件中得到一个合法的 ASCII 数字或者一个减号，如果读到 eof 则退出。

: get.digit/minus ( -- digit or - )

BEGIN

get.next.byte eof?

parenchk eof?

quotechk eof?

DUP ASCII - =

SWAP ?digit ROT OR NOT

WHILE

DROP

REPEAT ;

get.next.number 从磁盘文件中读入一个以 ASCII 串存储的有符号数，并把它转换成一个有符号的 16 位整数，如果读到 eof 则退出。

: get.next.number ( -- n )

{{ get.digit/minus eof? / uses {{ }} to store

BEGIN / consecutive digits

get.next.byte eof? / on the stack.

parenchk eof? / ignore (...)

quotechk eof? / and "..."

?digit NOT

UNTIL

DROP }}

DUP PAD C!

DUP PAD + BL OVER 1+ C!

SWAP 0 DO / move digits on stack

SWAP OVER C! 1- / to counted string as PAD

LOOP

NUMBER DROP ; / convert to number

?period 测试一个字节是不是一个小数点。注意标志作为为次栈顶元素。

: ?period ( byte -- f byte )

DUP ASCII . = SWAP ;

get.next.dnumber 从磁盘文件中读入一个以 ASCII 串存储的有符号实数，并把它转换成一个有符号双精度数放到堆栈上，小数点之后的数字数目放到变量 DPL 中，如果读到 eof 则退出。

: get.next.dnumber ( -- dn )

{{ get.digit/minus eof?

BEGIN

get.next.byte eof?

parenchk eof? / similar to

quotechk eof? / get.next.number

?period / but include period

?digit ROT OR NOT / in number string

UNTIL

DROP }}

DUP PAD C!

DUP PAD + BL OVER 1+ C!

SWAP 0 DO

SWAP OVER C! 1-

LOOP

NUMBER ; / convert to double number

get.next.string 从磁盘文件中读入包含在引号中的字符串，并把它存储成位于 addr 地址处的一个计数串。

: get.next.string ( -- addr ) / counted string

BEGIN

get.next.byte eof?

ASCII " =

UNTIL

0 PAD 1+

BEGIN / cnt addr

get.next.byte eof?

DUP ASCII " <>

WHILE

OVER C!

SWAP 1+ SWAP

1+

REPEAT

2DROP PAD C! PAD ;

7.7 数字和串

send.byte 输入一个字节到打开的文件中，文件的句柄在 handl 中。

: send.byte ( byte -- )

PAD C!

handl @

1 PAD write.file ;

send.number 把一个有符号的 16 位数字作为一个 ASCII 串写入打开的文件中，文件的句柄在 handl 中。

: send.number ( n -- )

(.) 0

DO

DUP C@ send.byte

1+

LOOP

DROP ;

send.number.r 把一个有符号 16 位数作为一个 ASCII 串写入一个打开的文件中，这个数字将被右对齐到一个宽度为 len 的字段中，并用 ASCII 空格填充。

: send.number.r ( n l -- )

>R (.) R>

OVER -

0 DO

BL send.byte

LOOP

0 DO

DUP C@ send.byte 1+

LOOP

DROP ;

send.dnumber 把一个有符号的 32 位数作为一个 ASCII 串写入打开的文件中，文件的句柄在 handl，小数点的位置由 DPL 的内容决定。

: send.dnumber ( d -- ) / DPL = #digits after dec. point

TUCK DABS <# DPL @ ?DUP

IF

0 DO # LOOP

ASCII . HOLD

THEN

#S ROT SIGN #>

0 DO

DUP C@ send.byte 1+

LOOP DROP ;

 

: send.val ( n -- ) / send 16-bit value

PAD ! handl @

2 PAD write.file ;

: send.dval ( d -- ) / send 32-bit value

PAD 2! handl @

4 PAD write.file ;

: send.string ( addr -- ) / addr of counted string

DUP C@

SWAP 1+ SWAP

0 DO

DUP I + C@

send.byte

LOOP

DROP ;

: send.crlf ( -- )

13 send.byte

10 send.byte ;

: send.lf ( -- )

10 send.byte ;

: send.cr ( -- )

13 send.byte ;

: send.tab ( -- )

9 send.byte ;

: send.( ( -- )

ASCII ( send.byte ;

: send.) ( -- )

ASCII ) send.byte ;

: send., ( -- )

ASCII , send.byte ;

: send." ( -- )

ASCII " send.byte ;

: send."string" ( addr -- )

send."

send.string

send." ;

第八课 定义字

8.1 CREATE ... DOES>

Forth 成对的字 CREATE...DOES> 用于定义一个“定义字”，所谓的定义字就是可以定义一个新字的字。定义字最独特的事情就是那些新字被指定的运行时间行为都是由这个定义字给出的，我们可以通过下面这个定义字来解释 CREATE ... DOES> （你需要在装入这些程序之前装入第七课的程序）。

: table ( list n +++ )

CREATE

0 DO

C,

LOOP

DOES> ( ix -- c )

+ C@ ;

这个字可以像下面这样来定义一个新字 junk

3 15 7 2 4 table junk

当字 table 被执行时，在 table 中 CREATE 和 DOES> 之间的 Forth 字被执行。这将要导致字 junk 被加入字典，下列这些值存储到 junk 的 pfa 中。

junk 的代码字段包含一个 CALL 指令，它将使 table 定义中 DOES> 之后的 Forth 字执行。由于这是一个 CALL 指令，所以当这些 Forth 指令执行的时候， junk 的 PFA 将放到堆栈上。这样，当字 junk 与一个放在堆栈上的索引 ix 共同执行的时候，索引将被加到 FPA 上， C@ 将取出那个位置上的字节。例如

2 junk .

将打印 15

CREATE...DOES> 的工作方式如下所示，当字被定义的时候，它将产生如下的字典结构：

 

注意 junk 的代码字段包含有 CALL 指令，它调用 table 的 PFA 之后的 CALL ^DOES 指令。这个 CALL ^DOES 指令是由table 的 (;CODE) 执行时插入到 junk 代码段的。这有两个效果：首先，它把 junk 的 PFA 放到堆栈上，其次，它执行 CALL DODOES ，也就是执行由 LSO2 指出的 CFA 在 LIST 段的 Forth 字。这正好是定义在 table 中的 DOES> 之后的那些字。

而特别重要的是：凡是被 table 定义的任何字都有与此相同的行为。这个强有力的特点将下面的章节中被引用，以用于定义各种不同的跳转表。

8.2 一个简单的跳转表

作为一个简单的定义字的例子，假设你希望创建一个名为 do.key 的跳转表：

这个表的用法是这样的：比如，我们设计了一个含有 5 个键的键盘，当你按下一个键的时候，栈顶将返回对应的键号 0-5 ，你希望执行与键对应的 Forth 字 0word, 1word, ... , 4word 这些字的 CFA 存储在跳转表中。

我们想定义一个字称为 JUMP.TABLE 来产生 do.key 或者其它相似的跳转表。

为了产生 do.key 我们输入

5 JUMP.TABLE do.key

0word

1word

2word

3word

4word

下面是 JUMP.TABLE 的定义：

: JUMP.TABLE ( n +++ )

CREATE

DUP , 0 ?DO

' ,

LOOP

DOES> ( n pfa -- )

SWAP 1+ SWAP / n+1 pfa

2DUP @ > / n+1 pfa (n+1)>nmax

IF

2DROP

ELSE

SWAP / pfa n+1

2* + / addr = pfa + 2(n+1)

PERFORM

THEN ;

在这个定义中，字 PERFORM 将执行 CFA 在栈顶所对应的字。

在 CREATE 之后的 DO 循环中， ' , (tick comma) 用于把 JUMP.TABLE do.key 之后字的 CFA 存储在表中。

8.3 使用任意值的跳转表

前面描述的跳转表有一个限制，索引值必须是从 0 开始的任意整数。通常的情况是：表中的数值就对应所按下的 ASCII 码值，所以，更通用的跳转表应该是一个值（比如一个 ASCII 码）和一个该值对应的 CFA 入口，可以是这样的：

这个表可以用于一个编辑器，其中 ASCII 码 8 将引起 Forth 字 bkspace 被执行， ASCII 码 17 (control-Q) 将引起字 quit 执行， ASCII 码 27 将执行字 escape ，如果有表中没有匹配的值，则默认执行字 chrout ，这个字可以在屏幕上显示字符。在 PFA 中的 3 是 (ASCII 码,CFA) 对的数量。为了生成这个表，你可以使用字 MAKE.TABLE

MAKE.TABLE do.key

8 bkspace

17 quit

27 escape

-1 chrout

而字 MAKE.TABLE 定义如下：

: MAKE.TABLE ( +++ )

CREATE

HERE 0 , 0 / pfa 0

BEGIN

BL WORD NUMBER DROP / pfa 0 n

DUP 1+ / pfa 0 n n+1

WHILE / pfa 0 n

, ' , / pfa 0

1+ / pfa cnt

REPEAT

DROP ' , / pfa cnt

SWAP !

DOES> ( n pfa -- )

DUP 2+ / n pfa pfa+2

SWAP @ / n pfa+2 cnt

0 DO / n code.addr

2DUP @ = / n addr (n=code)

IF / n addr

NIP 2+ LEAVE / -> CFA

THEN

4 + / n addr

LOOP

PERFORM ; ( Note: Default word has n on stack )

注意一个 -1 用于指示默认的字。在 WHILE 之前的 DUP 1+ 将使这个上 -1 在到达默认字之后变为 0 并退出 BEGIN...WHILE...REPEAT 循环。当 do.key 用一个栈顶的 ASCII 码执行时，上面定义的 DOES> 部分动作，或者匹配一个 ASCII 码的 CFA ，或者是默认字。注意如果默认字被执行， ASCII 码仍然在栈顶，所以它可以被显示在屏幕上。

8.4 使用 Forth 字的跳转表

使用前面的定义字 MAKE.TABLE 有一个缺点，就是在建立表的过程中 ASCII 码必须是已知的（否则你必须去查 ASCII 表）。如果能够使用 Forth 字 ASCII 和 CONTROL 来找到这些 ASCII 码可能会更方便。比如

ASCII A

将返回值 65 (hex 41) 在堆栈上，同样

CONTROL Q

将把值 17 (hex 11) 返回到堆栈上。另外，如果在构造跳转表的时候能够包含注释将更加方便，而使用 MAKE.TABLE 时并不具有这样的能力。我们将定义一个新字称为 EXEC.TABLE ，它将让我们构造与前面相同的跳转表，通过输入：

EXEC.TABLE do.key

CONTROL H | bkspace ( backspace key )

CONTROL Q | quit ( quit to DOS )

HEX 2B | escape DECIMAL

DEFAULT| chrout

字 EXEC.TABLE 的定义如下

: EXEC.TABLE ( +++ )

CREATE

HERE 0 , / pfa

DOES> ( n pfa -- )

DUP 2+ / n pfa pfa+2

SWAP @ / n pfa+2 cnt

0 DO / n code.addr

2DUP @ = / n addr (n=code)

IF / n addr

NIP 2+ LEAVE / -> CFA

THEN

4 + / n addr

LOOP

PERFORM ; ( Note: Default word has n on stack )

注意：这个定义字的 DOES> 部分与 MAKE.TABLE 的定义相同。然而它的 CREATE 部分更简单。它只是把一个 0 放到所定义的字 (do.key) 的 PFA 处，并把这个 PFA 放到堆栈上，之后程序就返回到 Forth 并执行 Forth 字 CONTROL H. 这时将把值 8 留在堆栈上。于是堆栈上的值是 PFA 8.

竖杠 | 是一个 Forth 字，它的定义如下：

: | ( addr n -- addr )

, ' , / store n and CFA in table

1 OVER +! ; / increment count at PFA

注意第一行是 , ' , (逗号 单引号 逗号) ，第一个逗号把 n ( ASCII 码 ) 写入被创建的表中，单引号(') 得到竖杠 | 后面字的 CFA ，后一个逗号把这个值写入表中。在同一行的其它 Forth 字都将被执行，比如 ( 或者 DECIMAL 。

字 DEFAULT| 定义如下

: DEFAULT| ( addr -- )

DROP ' , ;

它将丢弃 PFA，得到默认字 (chrout) 的 CFA ，通过逗号的执行把它写入表中。

8.5 弹出式菜单

这一部分将使用定义字 EXEC.TABLE 来定义对应于一个弹出式菜单按键的行为。这里定义的字可以用来构造一个很好的菜单驱动的程序。

在下面的处理中，这些键的 ASCII 码很有用

200 CONSTANT ' up

208 CONSTANT ' down

203 CONSTANT ' left

205 CONSTANT ' right

199 CONSTANT 'home

207 CONSTANT 'end

201 CONSTANT 'pg.up

209 CONSTANT 'pg.dn

210 CONSTANT 'ins

211 CONSTANT 'del

8 CONSTANT 'bksp

9 CONSTANT 'tab

13 CONSTANT 'enter

27 CONSTANT 'esc

187 CONSTANT 'f1

188 CONSTANT 'f2

189 CONSTANT 'f3

190 CONSTANT 'f4

191 CONSTANT 'f5

192 CONSTANT 'f6

193 CONSTANT 'f7

194 CONSTANT 'f8

195 CONSTANT 'f9

196 CONSTANT 'f10

下面这些变量用于每个菜单 :

VARIABLE row_start / row# of first menu item

VARIABLE col_start / col# of first char in first menu item

VARIABLE row_select / row# of selected item

VARIABLE no_items / no. of menu items

PREFIX

在当前的光标处读出字符和属性

CODE ?char/attr ( -- attr char )

MOV BH, # 0

MOV AH, # 8

INT 16 / read char/attr

MOV BL, AH

MOV BH, # 0

AND AH, # 0

PUSH BX

PUSH AX

NEXT

END-CODE

在当前的光标处写字符及属性

CODE .char/attr ( attr char -- )

POP AX

POP BX

MOV AH, # 9

MOV CX, # 1

MOV BH, # 0

INT 16 / write char/attr

NEXT

END-CODE

显示 n 个(字符,属性)对

CODE .n.chars ( n attr char -- )

POP AX

POP BX

POP CX

MOV AH, # 9

MOV BH, # 0

INT 16 / write n chars

NEXT

END-CODE

得到当前的视频模式

CODE get.vmode ( -- n )

MOV AH, # 15

INT 16 / current video state

MOV AH, # 0

PUSH AX

NEXT

END-CODE

: UNUSED ;

移动光标

: inc.curs ( -- )

IBM-AT? SWAP 1+ SWAP AT ;

反转属性画一个字符

: .char.bar ( attr char -- )

SWAP DUP 2/ 2/ 2/ 2/ 7 AND / swap foreground

SWAP 7 AND 8* 2* OR / and background

SWAP .char/attr ;

: togatt ( -- )

?char/attr / toggle attribute of char

.char.bar ; / at current cursor location

: invatt ( -- ) / toggle attribute of word

BEGIN

?char/attr DUP 32 = NOT

WHILE

.char.bar inc.curs

REPEAT 2DROP ;

: invline ( -- ) / invert line of text

BEGIN

invatt / invert word

togatt / invert blank

inc.curs

?char/attr / do until 2 blanks

NIP

32 =

UNTIL ;

: movcur ( -- ) / move cursor to selected row / double space

col_start @ row_select @

2* row_start @ + AT ;

: inv.first.chars ( -- )

no_items @ 0 DO

I row_select !

movcur togatt

LOOP ;

: select.first.item ( -- )

0 row_select !

movcur invline ;

: inv.field ( n -- )

movcur / invert current line

invline

row_select ! / invert line n

movcur

invline ;

上下光标键将改变所选择的项目

: down.curs ( -- )

movcur

invline

row_select @ 1+ DUP no_items @ =

IF

DROP 0

THEN

row_select !

movcur

invline ;

: up.curs ( -- )

movcur

invline

row_select @ 1- DUP 0<

IF

DROP no_items @ 1-

THEN

row_select !

movcur

invline ;

每个定义的光标都把下面的值存储在它的参数字段中

| upper.left.col | upper.left.row | width | no.items |

下面这些常数是对应各段的偏移 :

0 CONSTANT [upper.left.col]

2 CONSTANT [upper.left.row]

4 CONSTANT [width]

6 CONSTANT [no.items]

为了定义一个特定大小的菜单，你需要输入

{{ 25 [upper.left.col]

15 [upper.left.row]

20 [width]

3 [no.items] }}

define.menu menu1

定义字 define.menu 如下

: define.menu ( list n +++ )

CREATE

HERE 8 ALLOT SWAP / list pfa n

2/ 0 DO / v1 ix1 v2 ix2 v3 ix3 pfa

SWAP OVER + / v1 ix1 v2 ix2 v3 pfa addr

ROT SWAP ! / v1 ix1 v2 ix2 pfa

LOOP

DROP

DOES> ( pfa -- pfa )

DUP [upper.left.col] + @ 1+ col_start !

DUP [upper.left.row] + @ 1+ row_start !

DUP [no.items] + @ no_items ! ;

注意：这将定义字 menu1，使用值 25, 15, 20, 和 3 对应大小的菜单存储在参数字段中。回忆第七课双大括号 {{ ... }} 将把大括号之间的项目数量留在栈顶，所以你需要装入第七课的程序，然后再装入这里的程序，这样双大括号就有定义了。

当字 menu1 被执行时，它的参数字段的值将作为这个特定菜单的对应项目 col_start, row_start 和 no_items 所存储的值。

BOX&FILL 准备值，它是一个F-PC字，参看文件 BOXTEXT.SEQ 对于 BOX&FILL 的描述。

: ul.br ( pfa -- ul.col ul.row br.col br.row )

DUP [upper.left.col] + @ / pfa ul.col

OVER [upper.left.row] + @ / pfa ul.col ul.row

2 PICK [width] + @ 1- 2 PICK + / pfa ul.col ul.row br.col

3 ROLL [no.items] + @ 2* 2 PICK + ;

定义主菜单

{{ 25 [upper.left.col]

8 [upper.left.row]

20 [width]

3 [no.items] }}

define.menu main.menu

第一个菜单

{{ 30 [upper.left.col]

10 [upper.left.row]

20 [width]

2 [no.items] }}

define.menu first.menu

: first.menu.display ( -- )

0 inv.field / invert first item

SAVESCR / save screen

first.menu / get new coordinates

ul.br BOX&FILL / draw box

." First sub1 item"

bcr bcr ." Second sub1 item"

inv.first.chars

select.first.item ;

: first.sub1 ;

: second.sub1 ;

: escape.first ( -- )

RESTSCR

main.menu DROP

0 row_select !

2R> 2DROP

2R> 2DROP

EXIT ;

: enttbl.first ( n -- )

EXEC:

first.sub1

second.sub1 ;

: enter.first ( -- )

row_select @ enttbl.first ;

EXEC.TABLE do.key.first

'up | up.curs

'down | down.curs

ASCII F | first.sub1

ASCII f | first.sub1

ASCII S | second.sub1

ASCII s | second.sub1

'esc | escape.first

CONTROL M | enter.first ( enter key - select item )

DEFAULT| UNUSED

: first.item ( -- )

first.menu.display

BEGIN

KEY do.key.first

AGAIN ;

第二个菜单

{{ 30 [upper.left.col]

12 [upper.left.row]

20 [width]

2 [no.items] }}

define.menu second.menu

: second.menu.display ( -- )

1 inv.field / invert second item

SAVESCR / save screen

second.menu / get new coordinates

ul.br BOX&FILL / draw box

." First sub2 item"

bcr bcr ." Second sub2 item"

inv.first.chars

select.first.item ;

: first.sub2 ;

: second.sub2 ;

: escape.second ( -- )

RESTSCR

main.menu

1 row_select !

2R> 2DROP

2R> 2DROP

EXIT ;

: enttbl.second ( n -- )

EXEC:

first.sub2

second.sub2 ;

: enter.second ( -- )

row_select @ enttbl.second ;

EXEC.TABLE do.key.second

'up | up.curs

'down | down.curs

ASCII F | first.sub2

ASCII f | first.sub2

ASCII S | second.sub2

ASCII s | second.sub2

'esc | escape.second

CONTROL M | enter.second ( enter key - select item )

DEFAULT| UNUSED

: second.item ( -- )

second.menu.display

BEGIN

KEY do.key.second

AGAIN ;

主菜单

: main.menu.display ( -- )

DARK

main.menu / get new coordinates

ul.br BOX&FILL / draw box

." First item"

bcr bcr ." Second item"

bcr bcr ." Quit"

inv.first.chars

select.first.item

CURSOR-OFF ;

: quit.main ( -- )

CURSOR-ON DARK ABORT ;

: enttbl.main ( n -- )

EXEC:

first.item

second.item

quit.main ;

: enter.main ( -- )

row_select @ enttbl.main ;

EXEC.TABLE do.key.main

'up | up.curs

'down | down.curs

ASCII F | first.item

ASCII f | first.item

ASCII S | second.item

ASCII s | second.item

ASCII Q | quit.main

ASCII q | quit.main

CONTROL M | enter.main ( enter key - select item )

DEFAULT| UNUSED

: main ( -- )

main.menu.display

BEGIN

KEY do.key.main

AGAIN ;

8.6 练习

练习 8-1 定义一个定义字命名为 BASED. ，它将创建一个指定数基的数值输出字，例如

16 BASED. HEX.

将定义 HEX. 为一个字，它以 16 进制打印栈顶的值但不需要改变 BASE 。比如

DECIMAL

17 DUP HEX. .

将打印出

11 17 ok

练习 8-2 使用向量执行（也就是一个跳转表） 在 Forth 程序中对应不同的按键打印下列信息：

按下的键 信 息

F Forth is fun!

C Computers can compute

J Jump tables

N <your name>

按下其它的键将产生一声响铃 ( 使用 CONTROL G EMIT).

第九课 编译字

9.1 编译和解释

编译字是立即字，这意味着如果在一个冒号定义中遇到它们时，将被立即执行而不是编译到列表段。立即字在名字字段中有一个优先位。（见 see Lesson 3, Section 3.12 ） .

F-PC 处于两个可能的状态之一：编译或者解释。在一个冒号定义的编译期间它处于编译状态，就是说在字“冒号：”执行之后和“分号；”执行之前。系统变量STATE有下列两个可能的值：

TRUE -- 如果编译

FALSE -- 如果解释

为了测试当前在什么状态，我们考虑下面两个定义：

: 1state? ( -- )

STATE @

IF

." Compiling"

ELSE

." Interpreting"

THEN

CR ;

: 1test ( -- )

1state? ;

你把这个程序装入然后打入

1state?

和

1test

在每种情况下都是打印出 "interpreting" ，为什么？

因为，当你打印 1state? 和 1test. 时你都是处于解释状态。

你怎么才能够打印出 "Compiling" 呢？这就需要 1state? 在 1test 编译时执行，也就是说我们必须把 1state? 设计成一个立即字。我们可以通过在 ; 分号之后加一个字 IMMEDIATE 来实现这个目的。让我们定义

: 2state? ( -- )

STATE @

IF

." Compiling"

ELSE

." Interpreting"

THEN

CR ; IMMEDIATE

现在打入下面的定义

: 2test 2state? ;

注意当你打入这个定义的时候，只要你一按下 <Enter> ， Compiling 就会打印出来。也就是说， 2state? 被立即执行，并不等待你后面打入 2test. 现在打印

2test

注意没有任何东西打印在屏幕上，这是因为 2state? 没有被编译进字典，它只是立即执行。立即字并不被编译进字典，除非你强制这样做。你可以强制一个立即字被编译进字典而不再立即执行，这是通过字 [COMPILE] 实现的。

下面的字定义 3test 是字 2state? 被编译而不是被执行：

: 3test ( -- )

[COMPILE] 2state? ;

你觉得 3test 会打印什么？试一试。

也可以在冒号定义中使用字 [ 和 ] 来打开或者关闭编译。 [ 的定义是：

: [ ( -- )

STATE OFF ; IMMEDIATE

字 ] 打开编译模式并进入编译循环，编译循环包括：

DO

从输入流中得到下一个字，如果这是一个立即字，执行这个字；

否则编译它；

如果这个字不在字典中，把它转为一个数字并编译它 ;

UNTIL 输入流结束

作为最后一个例子，输入

: 4test [ 1state? ] ;

注意当你按下 <Enter> 后， "interpreting" 被打印出来，为什么？

9.2 字 COMPILE 和 [COMPILE]

我们已经看到： [COMPILE] 将把后面的立即字编译到列表段中。它的定义是：

: [COMPILE] ( -- )

' X, ; IMMEDIATE

字 "tick" (') 把下一个（立即）字的 CFA 放到堆栈上，字 X 编译堆栈上的整数到列表字典的下一个可有地址。注意 [COMPILE] 本身是一个立即数，在包含它的字编译期间可以被执行。

有时你希望在运行时编译一个字，字 COMPILE 将实现这个功能。例如， “semi-colon” 的定义基本上是这样的：

: ; ( -- )

COMPILE UNNEST / compile the UNNEST routine

REVEAL / make the colon word available

[COMPILE] [ / go to interpreting mode

; IMMEDIATE / do ; immediately

注意 ; 是一个立即字，在一个冒号定义中遇到它时被执行。它 COMPILE （编译）字 UNNEST 子程序的 CFA 到冒号定义字的列表字典，并通过字 REVEAL 使得这个冒号定义字在字典中可以搜索到，之后通过执行 [ 来切换在解释模式。尽管 [ 是一个立即字，但它在分号 ; 定义中被 [COMPILE] 编译。

COMPILE 的定义如下，当包含 COMPILE 的字执行时，它编译下面非立即字的 CFA 。

: COMPILE ( -- )

2R@ / get ES:SI of next CFA in list seg

R> 2+ >R / inc SI past next word in list seg

@L / get CFA on next word in list seg

,X ; / & compile it at run time

9.3 常数

考虑下面的冒号定义

: four+ ( n -- n+4 )

4 + ;

它编译的字典结构如下所示

字 (LIT) 是一个 CODE 字，它的定义如下 :

CODE (LIT) ( -- n )

LODSW ES: / get next word at ES:SI, SI=SI+2

1PUSH / push it on stack

END-CODE

于是字 (LIT) 将把数 4 压入堆栈，指令指针 ES:SI 将指向 + 的 CFA 。

如果你在堆栈上有一个数并希望把它作为一个常数编译到列表字典中，你可以使用 LITERAL ，定义如下：

: LITERAL ( n -- )

COMPILE (LIT) / compile (LIT)

X, / plus the value n

; IMMEDIATE / immediately

字 LITERAL 一个很有用的功能是你可以在定义中计算常数。例如，有时我们写 2+3 比写 5 更直观，你可以这样定义 five+:

: five+ ( n -- n+5 )

[ 3 2 + ] LITERAL + ;

当然你要是这样写，最后的结果与一样：

: five+ 3 2 + + ;

不过， [ 3 2 + ] LITERAL 有一个优点就是常数 5 是在编译期间计算出来的，运行的时候只是执行 5 + 。而 3 2 + + 却需要编译一个常数 3 和一个常数 2 到字典中，而在运行时也需要执行两个加法操作。所以，使用 [ 3 2 + ] LITERAL 产生的代码执行得更快、更有效。

9.4 条件编译字

BRANCH ?BRANCH

有两个条件编译字 BRANCH 和 ?BRANCH 被用于定义 F-PC 中各种条件分支指令。字 BRANCH 是一个 CODE 字，它的定义如下：

BRANCH 被编译到列表段，它的后面是无条件分支目的地址的偏移量。

字 ?BRANCH 在栈顶标志为假时分支到它后面的目的地址。它的定义如下

BEGIN...WHILE...REPEAT

作为一个 BEGIN...WHILE...REPEAT 循环的例子，我们回忆一下字第 4 课中 "factorial" 的定义：

: factorial ( n -- n! )

1 2 ROT / x i n

BEGIN / x i n

2DUP <= / x i n f

WHILE / x i n

-ROT TUCK / n i x i

* SWAP / n x i

1+ ROT / x i n

REPEAT / x i n

2DROP ; / x

这个定义将以下列方式存于列表字典中：

字 BEGIN 在栈顶留下 xhere1 的地址。字 WHILE 编译 ?BRANCH 之后放一个 0 在 xhere2. 这个值 0 将在以后被字 2DROP 的地址 xhere3 代替。而 WHILE 也把 xhere2 的值放在栈上并在 xhere1 之下。字 REPEAT 编译 BRANCH 并用 xhere1 的地址存储在它的之后，然后再把 xhere3 放到堆栈上并把它存入地址 seg:xhere2.

IF...ELSE...THEN

考虑如下的冒号定义

: test ( f -- f )

IF

TRUE

ELSE

FALSE

THEN ;

在列表字典中将按以下方式存储

字 IF 编译 ?BRANCH 后随一个 0 在地址 xhere1. 这个值 0 将在以后被字 FALSE 的地址 xhere3 代替。 IF 也在堆栈上留下 xhere1 的值。

字 ELSE 编译 BRANCH 后随一个 0 在地址 xhere2. 这个值 0 将在以后被字 UNNEST 地址 xhere4 代替。 ELSE 也在把地址留放到栈上之后在栈上留下 xhere2 值并把它存入地址 seg:xhere1.

字 THEN 把地址 xhere4 放到栈上然后把它存入地址 seg:xhere2.

BEGIN...AGAIN

作为一个使用 BEGIN...AGAIN 的例子，看第 8 课的弹出式菜单。它的典型形式是

: main ( -- )

minit

BEGIN

KEY do.key

AGAIN ;

在列表字典中按如下方式存储

字 BEGIN 在栈顶留下 xhere1 的偏移地址，字 AGAIN 编译 BRANCH 并把地址用 , 存入。

BEGIN...UNTIL

下面使用 BEGIN...UNTIL 的例子来自第 4 课：

: dowrite ( -- )

BEGIN

KEY

DUP EMIT

13 =

UNTIL ;

它将按以下方式存储在列表字典中：

字 BEGIN 在栈顶留下 xhere1 的地址。字 UNTIL 编译 ?BRANCH 并把 xhere1 写入，注意 BEGIN...AGAIN 和 BEGIN...UNTIL 的唯一差别是在 AGAIN 中用 UNTIL ?BRANCH 代替了 BRANCH.

DO...LOOP

一个 DO 循环将产生以下的列表字典：

字 DO 编译 (DO) 后随一个 0 在地址 xhere1 。这个值 0 后来将用 DO 循环之后的第一个字的地址 xhere2 代替。 DO 也在栈顶留下了 xhere1 的值。

字 LOOP 编译 (LOOP) 并用 , 写入到地址 xhere1+2. LOOP 然后把地址 xhere2 放到栈上并把它存入 seg:xhere1.

运行时间字

(DO) ( limit index -- )

建立如下的返回栈

运行时间字 (LOOP) 把返回栈顶的值加 1 并在溢出标志没有设置时跳转到 xhere1+2 ，如果溢出标志已经设置（当 index = limit 而栈顶越过了 8000H ） ，则 (LOOP) 从返回栈上弹出 3 个项目，并把指令指针 ES:SI 指向 xhere2.

把 xhere2 放在返回栈的第 3 项是为了 LEAVE 能够找到退出地址。把返回栈顶的 2 个值加上 8000H 可以使执行 (DO) 时 DO 循环能够正确处理 limit 大于 8000H 的情况。

例如，假设 limit 是 FFFFH ， initial index 是，返回堆栈上的 initial value o 将是 -7FFFH ，当这个值加 1 之后，溢出标志将不置位直到栈顶等于 8000H, 也就是 FFFFH 个循环之后。

9.5 练习

用字 SEE 和 LDUMP 观察下面 3 个测试字的字典结构：

: a.test ( f -- )

IF

." True"

ELSE

." False"

THEN ;

: b.test ( -- )

5 0 DO

I .

LOOP ;

: c.test ( -- )

4

BEGIN

DUP .

1- DUP 0=

UNTIL

DROP ;

请你为每个字画出字典结构，指出名字和字典中所有字段的实际值，指出字 IF、 ELSE、THEN、DO、LOOP、BEGIN 和 UNTIL 的实际效果。也请解释字 ." 在 a.test 的工作方式，数 5、 0 和 4 在 b.test 和 c.test. 的工作情况。

第十课 Forth 数据结构

10.1 数组

这一课的许多内容都来自于Dick Pountain所著的 《 Object-oriented Forth》(Academic Press, 1987)一书。我们将扩展书中的思想，并且来实际使用系统全部存储器。

F-PC 字 ALLOC ( #para -- #para segment flag ) 和 DEALLOC ( segment -- flag ) 使用 DOS 功能调用 AH = 48H 和 AH = 49 来分配和释放存储器，通过这些字我们可以定义以下的字来分配和释放存储器。

: alloc.mem ( size -- segment )

PARAGRAPH ALLOC / DOS alloc INT 21H - AH=48H

8 =

ABORT" Not enough memory to allocate "

NIP ; / discard #para allocated

: release.mem ( segment -- )

DEALLOC / DOS INT 21H - AH=49H

ABORT" Failed to deallocate segment "

;

字 alloc.mem 要求在堆栈上你期望分配的存储器字节数，并返回所分配块的段地址。 F-PC 字

: PARAGRAPH 15 + U16/ ;

可以把所要求的字节数量转换为 16 字节的页的数量。

字 release.mem 将释放由 alloc.mem 所分配的存储器。首先你把期望释放块的段地址放到堆栈上(这必须是前面由 alloc.mem 调用而返回的地址)。

现在假设你希望在扩展存储器里创建了一个一定大小的数组，然后使用 @L 和 !L 进行数组单元读写。我们可以定义以下的定义字：

: array ( size +++ )

CREATE

2* DUP alloc.mem , / save seg address

, / save array size in bytes

DOES>

@ ;

接着你可以这样：

1000 array array.name

这将创建一个字典项目 array.name, 并分配 1000 字的存储器，再把所分配存储器的段地址和大小放到 array.name 的参数域中，当后面调用 array.name 时将把这个段地址放到堆栈上。

字典项 array.name 按以下的方式存储在存储器中：

为了访问数组元素 array.name(5), 可以输入：

array.name 5 @L

使用这种策略来访问扩展存储器中的数组有一个问题：如果你构造一个独立系统(turnkey) 时就会失败。一个独立的系统将删除字典的首部并构造一个 .EXE 文件，其中含有程序字和所有的 F-PC 字。当你保存这个系统的时候，你已经定义的每个数组的代码段部分都会保存，但是给实际数组分配的存储器将丢失。这就意味着当 turnkey 程序运行的时候，它必须以某种方式为数组分配所需要的存储器，并把段地址存储到数组名字的 PFA 处。

我们可以按下面的方式修改 array 的定义使之可以用于 turnkey 系统。

: array.tk ( size +++ )

CREATE

0 , / fill in seg address later

2* , / save array size in bytes

DOES>

@ ;

注意你现在应该输入

1000 array.tk array.name

你可以创建字典项 array.name 并保存尺寸 1000 ，但在这个时刻没有为数组分配任何空间。

存储器可以在以后使用下面的字来分配：

: alloc.array ( cfa -- )

>BODY DUP 2+ @ / get size in bytes

alloc.mem / allocate memory

SWAP ! ; / save seg at PFA

: allocate.arrays ( -- )

[ ' array.name ] LITERAL alloc.array ;

字 allocate.arrays 中应该对你程序中定义的每个数组包含一个相似的行。你应该把这个字作为你的初始化程序的一部分，这就使得你的 turnkey 系统也能分配存储器。

你可以使用下面的字来释放分配的存储器。

: release.array ( cfa -- )

>BODY @ / get segment address

release.mem ; / and release it

: release.all.arrays ( -- )

[ ' array.name ] LITERAL release.array ;

你可以在 release.all.arrays 加入相似的行，只要你想释放这些存储器。

10.2 链表

在这一部分中，我们将编写一些字来创建和维护链表。

链表中的每个节点都包含有 4 个字节，前两个是指向下一个节点的指针，后两个是对应节点的值。

当我们向链表加入一个值的时候，首先需要从自由链表的大池中得到一个节点，当需要从链表中删去一个值的时候，就需要把这个节点返回给自由链表。可以在存储器中分配一个大的存储器块作为自由链表区，然后链接所有的节点成为如下的方式：

可用的节点从 <list.seg> 段的偏移地址 4 开始，之后以 4 的倍数为步长分配，自由链表的头指针在地址 <list.seg>:2. 在 <list.seg>:0 处的值没有使用，下面的字将创建自由链表：

/ Variables and Constants

DECIMAL

0 CONSTANT nil

2 CONSTANT [freelist.head]

0 VALUE <list.seg>

[freelist.head] VALUE [list.offset]

分配存储器

: release.seglist ( -- )

<list.seg> ?DUP

IF

DEALLOC 0= / DOS INT 21H - AH=49H

IF

0 !> <list.seg>

ELSE

ABORT" Failed to deallocate <list.seg> "

THEN

THEN ;

: alloc.seglist ( size -- )

release.seglist

2* 2* 4 + / 4 bytes/node + head

alloc.mem / allocate memory

!> <list.seg> ; / <list.seg> = base segment address

创建自由链表 Nodes: | ptr | val |

: allocate.freelist ( size -- )

DUP alloc.seglist / size

[list.offset] 2+ / next ptr addr

<list.seg> [list.offset] !L / store at current ptr

2 +!> [list.offset] / make next ptr current ptr

1 DO / do size-1 times

[list.offset] 4 + / next ptr addr

<list.seg> [list.offset] !L / store at current ptr

4 +!> [list.offset] / make next ptr current ptr

LOOP

nil <list.seg> [list.offset] !L / make last ptr nil

4 +!> [list.offset] ; / [list.offset] --> eolist

: freelist ( -- seg offset )

<list.seg> [freelist.head] ;

节点处理的字

下面的字将在地址 seg:node 的一个地址为 seg:list 节点之后插入一个节点

: node.insert ( seg list seg node --- ) / insert after seg:list

2OVER @L / s l s n @l

ROT 2 PICK / s l n @l s n

!L / s l n

-ROT !L ;

下面的字移去指针在 seg:list 的之后的节点，并把被移去节点的地址 seg:node 放到堆栈上。如果 seg:list 是头，这个字移去表中的第一个节点，如果表为空则返回 seg:0.

: node.remove ( seg list -- seg node )

2DUP @L / s l @l

2 PICK SWAP DUP / s l s @l @l

IF / s l s @l

2SWAP 2OVER @L / s @l s l @@l

-ROT !L / s n

ELSE / s l s 0

2SWAP 2DROP / s 0

THEN ;

为了从自由表中得到你刚刚移去的节点，需要使用 getnode.

: getnode ( --- seg node )

freelist node.remove ;

为了把 seg:node 节点放回到自由列表，使用 freenode.

: freenode ( seg node --- )

freelist 2SWAP / seg list seg node

node.insert ;

字 newlist 在代码段中创建一个新的列表头，这个表头的 PFA 包含有表头段 <list.seg> 的偏移地址。

: newlist ( +++ )

CREATE

nil , / fill in node addr later

DOES> ( -- seg list )

<list.seg> SWAP @ ;

为了创建一个名字为 sample.list 的新表，输入

newlist sample.list

你可以在段 <list.seg> 为这个表创建一个头，方法是在字 fill.newlists.

中包含以下行：

: fill.newlists ( -- )

getnode DUP [ ' sample.list ] LITERAL >BODY ! nil -ROT !L ;

这种技术用于 turnkey 系统中，与我们说过的数组相同。在你可以使用任何这些数据结构之前，你必须分配存储器：

: init.data.structures ( -- )

allocate.arrays

1200 allocate.freelist

fill.newlists ;

现在你就可以测试这些字了：

init.data.structures

5 sample.list push

使用下面的 PUSH

: push ( value seg list -- )

getnode ?DUP

IF / v s l s n

4 ROLL 2 PICK 2 PICK / s l s n v s n

2+ !L node.insert

ELSE

." no free space " ABORT

THEN ;

也可以 sample.list pop 使用下面的 POP

: pop ( seg list -- value )

node.remove ?DUP

IF / s n

2DUP freenode / put node back in freelist

2+ @L / get value

ELSE

." empty list " ABORT

THEN ;

为了打印表 sample.list 的内容，你可以输入 sample.list .all 使用下面的字

: .all ( seg list -- ) / print list contents

BEGIN / s l

OVER SWAP @L ?DUP / s n n

WHILE

2DUP 2+ @L . / s n

REPEAT

DROP ;

为了生成表 sample.list 中的所有节点，你输入 sample.list kill 使用下面的字

: kill ( seg list -- ) / reclaim list space

BEGIN / s l

2DUP node.remove ?DUP / s l s n n

WHILE freenode / s l

REPEAT DROP 2DROP ;

下面的字用于测试一个特别的字是不是在一个表中，例如：

5 sample.list ?in.list

我们可以 5 确认在表中的时候返回一个标志：

: ?in.list ( val seg list -- val f )

>R FALSE -ROT R> / 0 v s l

BEGIN / 0 v s l

ROT 2 PICK 2 PICK / 0 s l v s l

@L ?DUP / 0 s l v n n

WHILE

3 PICK SWAP / 0 s l v s n

2+ @L OVER = / 0 s l v f - true if v'=v

IF NIP NIP NIP TRUE EXIT / v tf

THEN / 0 s l v

-ROT OVER SWAP @L / 0 v s n

REPEAT

NIP NIP SWAP ; / v ff

字 ?pop 可以用于在表不空时返回表的头。如果这个表是空的，将在栈顶放一个假标志。如果你不能确定一个表是不是空的，而又不想在表空时异常退出，这个字就很有用：

: ?pop ( seg list -- value tf | ff ) / ff if list is empty

node.remove ?DUP

IF / s n

2DUP freenode / put node back in freelist

2+ @L TRUE / get value

ELSE

DROP FALSE

THEN ;

字 ?list.empty 在表空时返回一个标志

: ?list.empty ( seg list -- f )

2DUP ?pop / try to pop

IF / if something in list

-ROT push FALSE / push it back - set false

ELSE

2DROP TRUE / else, set true

THEN ;

字 findpos< 确定表中一个节点的位置，以使得这个节点插入之后，表按递增顺序构造。例如，为了按递增顺序插入值 35 ，你需要

/ 35 sample.list findpos< push

: findpos< ( val seg list -- val seg node )

BEGIN / v s l

ROT 2 PICK 2 PICK / s l v s l

@L ?DUP / s l v n n

WHILE

3 PICK SWAP / s l v s n

2+ @L OVER > / s l v f - true if v'>v

IF

-ROT EXIT / v s l

THEN / s l v

-ROT OVER SWAP @L / v s n

REPEAT

-ROT ; / v s l

字 findpos> 确定表中一个节点的位置，以使得这个节点插入之后，表按递减顺序构造。例如，为了按递减顺序插入值 35 ，你需要

35 sample.list findpos> push

: findpos> ( val seg list -- val seg node )

BEGIN / v s l

ROT 2 PICK 2 PICK / s l v s l

@L ?DUP / s l v n n

WHILE

3 PICK SWAP / s l v s n

2+ @L OVER < / s l v f - true if v'<v

IF

-ROT EXIT / v s l

THEN / s l v

-ROT OVER SWAP @L / v s n

REPEAT

-ROT ; / v s l

下面的字可以找到节点中第 n 个节点的地址。例如，为了得到表 sample.list 中第 5 个节点的值，你可以输入：

sample.list 5 traverse.n 2+ @L

: traverse.n ( seg list n -- seg addr ) / find address on nth node

?DUP

IF / s l n

0 DO / s l

OVER SWAP / s s l

@L DUP 0= / s n f

IF

." Beyond list end " ABORT

THEN

LOOP / s n

THEN ; / s l if n=0

下面字用于得到一个表中节点的数目。例如

sample.list get.#nodes .

将打印表 sample.list 节点的数目

: get.#nodes ( seg list -- n )

0 -ROT / 0 s l

BEGIN / cnt s l

OVER SWAP / cnt s s l

@L ?DUP / cnt s @l @l | cnt s 0

WHILE / cnt s @l

ROT 1+ -ROT / cnt+1 s @l

REPEAT

DROP ; / cnt

10.3 记录

这一部分的字用于产生更灵活的链接记录系统，其中的每个记录是一个在存储器中独立的段，这些记录可以通过记录中的指针字段实现链接。我们可以定义任何不同的记录，可以创建任何数目的记录实例，并链接到一个层次系统中。记录中字段的尺寸都可以是任何大小。

我们通过一个学生记录系统的简单例子来解释这个记录字集的使用。每个学生都指定下列的记录：

头 sr.head:0 包含有第一个学生记录的段地址。 <SR.NODE> 的第一个元素含有当前记录的字段数。在偏移地址 [NEXT.SR] 的第一个字段中含有一个指针( segment address)到下一个学生记录。位于地址 [NAME.SR] 的第二字段含有学生的名字。

位于 [ADDR.SR] 的第三个字段含有一个指针 ( 段地址 ) 指向一个地址记录。这个记录可以包含分离的字段用于街道、城市、省和邮政编码。位于偏移地址 [DATA.SR] 的第 4 个字段是一个指针（段指针）指向一个数据记录，这个记录也可以包含有不同的字段用于性别、年龄、班组、专业和其它的数据。

这个记录可以通过下面这些字来创建：

VARIABLE total.bytes 2 total.bytes !

声明字段的名称

: field ( n +++ )

CREATE

total.bytes @ , / store offset

total.bytes +! / bump offset count

IMMEDIATE

DOES> ( seg pfa -- seg off )

@ / get field address

STATE @ / if compiling

IF

[COMPILE] LITERAL / ...bind early

THEN ;

构造一个记录类型的铺例(内部使用)

: make.instance ( seg off n --- seg )

DUP alloc.mem / allocate fields

TUCK 0 !L / store instance size

DUP 2SWAP !L / store new seg at seg:off

IMMEDIATE ;

创建记录定义字

: define-record ( +++ )

CREATE

total.bytes @ , / store instance size

2 total.bytes ! / reset the count

DOES> ( seg off -- seg' )

@ make.instance ;

1 array sr.head

: sr.list ( -- seg off )

sr.head 0 ;

下面这些字段是 sr 节点的偏移量

2 field [NEXT.SR] / pointer (seg addr) to next node

2 field [NAME.SR] / pointer (seg addr) to student name

2 field [ADDR.SR] / pointer (seg addr) to student address record

2 field [DATA.SR] / pointer (seg addr) to student data

define-record SR-REC

注意字 field 是一个定义字，定义名字和对应的在学生记录 <SR.NODE> 中的偏移地址。当这些字创建时，变量 total.bytes 的值写入被创建字的 PFA 中，并按这个字段调用时的栈顶值来增量 total.bytes 的值。 ( total.bytes 初始值从 2 开始 )。 这种技术可以为不同宽度的字段产生正确的偏移地址。字段也可以按需要增加或者减少而不需要关心它的偏移地址。

语句

define-record SR-REC

将产生一个字称为 SR-REC ，这个字将在后面用于创建学生记录的实例

为了完成这个例子，我们可以定义以下的学生记录

下面这些字段是学生数据节点的偏移量

2 field [SEX.D] / sex - 1 char counted string M or F

11 field [BIRTH.D] / date of birth - M/D/YR string

11 field [ENTER.D] / date of enterance - M/D/YR string

2 field [MAJOR.D] / major code

2 field [GPA.D] / GPA x 100

define-record DATA-REC

下面字段是名字节点的偏移

24 field [NAME.FN] / student name - counted string

define-record NAME-REC

下面字段是地址节点的偏移

16 field [STREET.AD] / street address

16 field [CITY.AD] / city

3 field [STATE.AD] / state - 2 char abbrev

11 field [ZIP.AD] / zip code

define-record ADDR-REC

0 VALUE <SR.NODE> / SR node seg address

0 VALUE <NODE.NAME> / name node seg address

0 VALUE <NODE.ADDR> / address node seg address

0 VALUE <NODE.DATA> / SR data node seg address

下面字用于创建和删除一个学生记录

: >end.of.SR.list ( seg list -- seg end.of.list.node )

BEGIN / s/l

2DUP @L ?DUP / s/l/@l/ @l

WHILE / s/l/@l or /s/l

NIP NIP [NEXT.SR] / @l/off

REPEAT ;

: make.SR.record ( seg off -- )

>end.of.SR.list

SR-REC DUP !> <SR.NODE>

DUP 0 SWAP [NEXT.SR] !L

DUP [NAME.SR] NAME-REC !> <NODE.NAME>

DUP [ADDR.SR] ADDR-REC !> <NODE.ADDR>

[DATA.SR] DATA-REC !> <NODE.DATA> ;

: zero.<nodes> ( -- )

0 !> <SR.NODE>

0 !> <NODE.NAME>

0 !> <NODE.ADDR>

0 !> <NODE.DATA> ;

: release1.SR ( ^SR -- )

DUP [NAME.SR] @L release.mem

DUP [ADDR.SR] @L release.mem

DUP [DATA.SR] @L release.mem

release.mem ;

: release.all.SR ( seg off -- )

2DUP @L ?DUP

IF

BEGIN

DUP [NEXT.SR] @L

SWAP release1.SR ?DUP

WHILE

REPEAT

0 -ROT !L

THEN

zero.<nodes> ;

为了增加一个记录你可以输入

sr.list make.SR.record

你接着可以通过键盘或者磁盘文件加入数据到不同的字段。例如

345 <NODE.DATA> [MAJOR.D] !L

将把值 345 存入 major field 。

第十一课 使用中断的终端程序

11.1 8086/8088 中断

在这一课，我们要编写一个基于中断模式工作的终端程序，以使得我们能够与其它计算机通信或者下载 Forth 代码到单片机中，比如下载到包含有 Max-Forth 的 MC68HC11 单片机中。

我们希望用 9600 波特率通信，这就意味着必须使用中断来存储到来的字符，否则在屏幕滚动时它们就会丢失。我们可以写一个中断服务程序，它在串口每收到一个字符之后就被调用一次，中断服务程序读出字符并把它们存储到队列中。终端主程序不断地检测键盘是否按下以及队列中有没有收到字符。当一个键按下时，输入的字符将发送到串行口。当队列中有字符时（也就是串行口收到了字符），这个字符将显示到屏幕上，也可以选择保存到磁盘上。

中断服务程序的段地址和偏移量必须存储到 0 段存储器的中断向量表中。 DOS 功能 25H (set interrupt vector) 和 35H (get interrupt vector) 可以用于这个目的。而下面这些字更方便了实现：

PREFIX HEX

CODE get.int.vector ( int# -- seg offset )

POP AX

PUSH ES

PUSH BX / AL = interrupt number

MOV AH, # 35 / DOS service 35H

INT 21 / ES:BX = segment:offset

MOV DX, ES / of interrupt handler

MOV AX, BX

POP BX

POP ES

2PUSH

END-CODE

CODE set.int.vector ( segment offset int# -- )

POP AX / AL = interrupt number

POP DX / DX = offset addr

POP BX / BX = segment addr

MOV AH, # 25 / DOS service 25H

PUSH DS / save DS

MOV DS, BX / DS:DX -> int handler

INT 21 / DOS INT 21H

POP DS / restore DS

NEXT

END-CODE

/ Store interrupt vector of routine at addr

: store.int.vector ( addr int# -- )

?CS: -ROT set.int.vector ;

我们需要第 7, 8 和 10 课的字，因此应该先装入它们：

DECIMAL

fload lesson7

fload lesson8

fload lesson10

11.2 8250 ACE 芯片

串行通信由 8250 异步通信接口器件(ACE)芯片处理，从这个芯片来的中断线连接到优先级控制器 (PIC) 芯片上， COM1 连接 IRQ4 ， COM2 连接 IRQ3 。 8250 的 MODEM 寄存器必须在使能 8250IRQ 线输出缓冲区之前设置。

HEX

300 CONSTANT COM1 / base address for COM1

200 CONSTANT COM2 / base address for COM2

0C CONSTANT INT#1 / interrupt number for COM1

0B CONSTANT INT#2 / interrupt number for COM2

EF CONSTANT ENABLE4 / interrupt 4 enable mask

10 CONSTANT DISABLE4 / interrupt 4 disable mask

F7 CONSTANT ENABLE3 / interrupt 3 enable mask

08 CONSTANT DISABLE3 / interrupt 3 disable mask

Default COM1

COM1 VALUE COM / current COM base address

INT#1 VALUE INT# / interrupt # for current COM

ENABLE4 VALUE ENABLE / enable mask for current COM

DISABLE4 VALUE DISABLE / disable mask for current COM

下面这些值被加入到COM的基地址以得到对应的寄存器地址

F8 CONSTANT txdata / transmit data reg (write only)

F8 CONSTANT recdat / receive data reg (read only)

FC CONSTANT mcr / modem control reg

F9 CONSTANT ier / interrupt enable reg

FD CONSTANT lsr / line status reg

21 CONSTANT imask / mask reg in PIC

20 CONSTANT eoi / end of int value

20 CONSTANT ocw2 / PIC ocw2

VARIABLE int.vec.addr / save int vector offset address

VARIABLE int.vec.seg / save int vector segment address

DECIMAL

我们使用 BIOS INT 14H 的通信口初始化子程序 (AH = 0) 来设置波特率，这个操作必须在 MODEM 控制寄存器中断位使能之前设置，因为 INT 14H 调用将屏蔽它们。

下表的参数用于控制寄存器设置，波特率为300, 1200, 2400, 4800 和 9600 ，无校验， 8 数据位， 1 停止位。

CREATE baud.table 67 , 131 , 163 , 195 , 227 ,

Index Baud rate

0 300

1 1200

2 2400

3 4800

4 9600

CODE INIT-COM ( mask -- )

POP AX

MOV AH, # 0

MOV DX, # 0

INT 20

NEXT

END-CODE

默认的波特率为 9600 ，如果要修改波特率，就应该修改这个字

: get.baud# ( -- n )

4 ;

: set.baud.rate ( -- )

get.baud# 2*

baud.table + @

INIT-COM ;

11.3 队列数据结构

在中断服务子程序中，使用一个环形队列来存储接收到的字符，下列指针用于定义这个队列：

VARIABLE front / pointer to front of queue (oldest data at front+1)

VARIABLE rear / pointer to rear of queue (most recent data at rear)

VARIABLE qmin / pointer to first byte in queue

VARIABLE qmax / pointer to last byte in queue

VARIABLE qbuff.seg / segment of queue

10000 CONSTANT qsize / size of queue in bytes

初始化队列

: initq ( -- )

qsize alloc.mem qbuff.seg ! / allocate memory for queue

0 front ! / front = 0

0 rear ! / rear = 0

0 qmin ! / qmin = 0

qsize 1- qmax ! ; / qmax = qsize - 1

检查队列

: checkq ( -- n tf | ff )

front @ rear @ <> / if front = rear

IF / then empty

INLINE

CLI / disable interrupts

NEXT

END-INLINE

1 front +! / inc front

front @ qmax @ > / if front > qmax

IF

qmin @ front ! / then front = qmin

THEN

qbuff.seg @ front @ C@L / get byte

TRUE / set true flag

INLINE

STI / enable interrupts

NEXT

END-INLINE

ELSE

FALSE / set false flag

THEN ;

把AL中的字节存储到队列中

LABEL qstore

PUSH SI

PUSH ES

MOV SI, qbuff.seg

MOV ES, SI / ES = qbuff.seg

INC rear WORD / inc rear

MOV SI, rear / if rear > qmax

CMP SI, qmax

JBE 2 $

MOV SI, qmin / then rear = qmin

MOV rear SI

2 $: CMP SI, front / if front = rear

JNE 4 $ / then full

DEC SI / dec rear

CMP SI, qmin / if rear < qmin

JAE 3 $ / then rear = qmax

MOV SI, qmax

MOV rear SI

3 $: POP ES

POP SI

RET

4 $: MOV ES: 0 [SI], AL / else store at rear

POP ES

POP SI

RET

END-CODE

中断服务子程序，下列程序从串行口得到数据并把它们存储到队列中

LABEL INT.SRV ( -- )

PUSH AX

PUSH DX

PUSH DS

MOV AX, CS

MOV DS, AX / DS = CS

MOV DX, # COM / if data is ready

ADD DX, # lsr

IN AL, DX

TEST AL, # 1

JE 1 $

MOV DX, # COM

ADD DX, # recdat

IN AL, DX / read it

CALL qstore

1 $: MOV AL, # eoi

MOV DX, # ocw2

OUT DX, AL / clear eoi

POP DS

POP DX

POP AX

IRET

END-CODE

设置中断

: int.setup ( -- )

12 COM mcr + PC! / modem cr out2 lo

1 COM ier + PC! / enable recv int

INT# get.int.vector / save old int vector

int.vec.addr ! int.vec.seg !

INT.SRV INT# store.int.vector ; / set new int vector

终端初始化子程序

: init.term ( -- )

initq / initialize queue

int.setup / set up interrupts

imask PC@

ENABLE AND / enable irq4 (COM1 default)

imask PC! ;

: disable.term ( -- )

imask PC@

DISABLE OR / disable irq4 (COM1 default)

imask PC!

0 COM mcr + PC! / 0 -> modem control reg

int.vec.seg @ / restore original

int.vec.addr @ / interrupt vector

INT# set.int.vector ;

11.4 输出字符到屏幕和 / 或磁盘

队列中的字符将被打印到屏幕，如果选定，则发送到一个磁盘文件中去：

FALSE VALUE ?>disk / flag to "send to disk"

0 VALUE col.at / saved cursor position

0 VALUE row.at

VARIABLE t_handle / terminal file handle

CREATE edit_buff 70 ALLOT / temporary edit buffer

: $HCREATE ( addr -- f ) / create file for counted string at addr

SEQHANDLE HCLOSE DROP

SEQHANDLE $>HANDLE

SEQHANDLE HCREATE ;

: file.open.error ( -- )

33 12 65 14 box&fill

." Could not open file!!"

KEY DROP ;

以下这些字用于在屏幕上打开一个窗口输入文件名，然后打开这个文件。从串行口来的数据将写入这个文件，这个字在按下 F1 键时被调用。

: select.nil.file ( -- )

20 4 60 7 box&fill

." Enter a filename"

" " ">$

edit_buff OVER C@ 1+ CMOVE

21 6 edit_buff 30 lineeditor

IF

edit_buff $HCREATE

IF

file.open.error

ELSE

SEQHANDLE >HNDLE @

DUP handl ! t_handle !

TRUE !> ?>disk

THEN

THEN ;

: >term ( -- )

t_handle @ handl ! ;

按下 F1 键后将打开数据捕获

: disk.on.nil ( -- )

IBM-AT? !> row.at !> col.at

SAVESCR

select.nil.file

RESTSCR

col.at row.at AT ;

按下 F2 键后将打开数据捕获

: disk.off ( -- )

t_handle @ ?DUP

IF

close.file

0 t_handle !

THEN

FALSE !> ?>disk ;

输出 ASCII 代码到串行口

: XMT ( ascii -- )

COM / use base address in COM

BEGIN

DUP lsr + / wait for bit 5 in line status

PC@ 32 AND / register (TDRE) to be set

UNTIL

txdata + PC! ; / send data

按 CTRL P 键将打开和关闭打印机

: ?PRINT ( -- )

PRINTING C@ NOT PRINTING C! ;

输出字符到屏幕

: do.emit ( n -- )

DUP 13 = / if CR

IF

DROP CR / do a carriage return

ELSE

DUP 32 >= / ignore other control characters

IF

EMIT

ELSE

DROP

THEN

THEN ;

: ?EMIT ( n -- )

127 AND / mask parity bit

DUP 13 = / ignore control char

OVER 10 = OR / other than CR and LF

OVER 32 >= OR

IF

?>disk / if data capture on

IF

DUP >term send.byte / send to disk

THEN

do.emit / send to screen

ELSE

DROP

THEN ;

11.5 下载文件

以下这些字可以用于向 MC68HC11 下载包含 MaxForth 代码的文件，MaxForth 每次读入一行，编译字到字典中。读入一行之后，它将发送一个换行 (ASCII 10) 到 PC 机。

VARIABLE wait.count

发送一个串，给出它的地址和长度

: xmt.str ( addr cnt -- ) / XMT string + CR

0 DO

DUP I + C@

XMT

LOOP

DROP

13 XMT ;

等待接收一个特殊字符

: wait.for ( ascii -- )

0 wait.count !

BEGIN

checkq / char n tf | char ff

IF / char n | char

DUP ?EMIT / char n

OVER = / char f

0 wait.count !

ELSE

1 wait.count +! FALSE / char ff

THEN

wait.count @ 32000 = / char f f

IF

CONTROL G EMIT 2DROP / beep

CR ." No response..."

KEY DROP

2R> 2DROP / exit wait.for

2R> 2DROP / exit file.download

EXIT / exit DO-KEY

THEN

UNTIL

DROP ;

下载文件到 MC68HC11

: file.download ( -- )

GETFILE

DARK

IF

$HOPEN

IF

file.open.error

ELSE

." File: " .SEQHANDLE CR

BEGIN

LINEREAD COUNT 2- / addr cnt

OVER C@ 26 = NOT / while not EOF

WHILE

xmt.str / send line

10 wait.for / wait for LF

REPEAT

CLOSE

THEN

ELSE

2R> 2DROP

EXIT / exit DO-KEY

THEN ;

11.6 终端主程序

按下 ESC 键之后将退出字 HOST

: ESC.HOST ( -- )

disable.term / disable all interrupts

disk.off / close file if necessary

qbuff.seg @ release.mem / release queue buffer

DARK

ABORT ;

所有键的跳转表

EXEC.TABLE DO-KEY

CONTROL P | ?PRINT ( PRINTER ON/OFF )

27 | ESC.HOST ( ESCAPE KEY )

187 | disk.on.nil ( F1 ) 188 | disk.off ( F2 )

189 | file.download ( F3 ) 190 | UNUSED ( F4 )

191 | UNUSED ( F5 ) 192 | UNUSED ( F6 )

193 | UNUSED ( F7 ) 194 | UNUSED ( F8 )

195 | UNUSED ( F9 ) 196 | UNUSED ( F10 )

199 | UNUSED ( HOME ) 200 | UNUSED ( UP )

201 | UNUSED ( PUP ) 203 | UNUSED ( LEFT )

205 | UNUSED ( RIGHT ) 207 | UNUSED ( END )

208 | UNUSED ( DOWN ) 209 | UNUSED ( PGDN )

210 | UNUSED ( INS ) 211 | UNUSED ( DEL )

DEFAULT| XMT

: T-LINK ( -- )

set.baud.rate

CURSOR-ON

FALSE !> ?>disk

DARK

." 4thterm is on-line..." CR CR

init.term ;

为了运行终端程序，打入 HOST

: HOST T-LINK

BEGIN

KEY?

IF

KEY DO-KEY

THEN

checkq

IF

?EMIT

THEN

AGAIN ;