當前位置：首頁 > 编程资源 > 编程问答 >内容正文

编程问答

Forth语言简明教程

發布時間：2023/12/18 编程问答 40 豆豆

生活随笔收集整理的這篇文章主要介紹了 Forth语言简明教程小編覺得挺不錯的,現在分享給大家,幫大家做個參考.

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 語言簡介

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 內層解釋器操作。

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

ELSE

而在 Forth 中， IF 語句是這樣的：

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 -- )

I .

LOOP ;

然后你輸入：

5 0 dotest

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

DO 循環是這樣工作的: 字 DO 從參數棧頂上取兩個值并把它們放到返回棧上。這時這兩個值已經不在參數棧上了。字 LOOP 將索引值加 1 并把結果與限值進行比較。如果增量之后的索引值小于限值，則分支到 DO 下面的字。如果增量之后的索引值等于限值，則分支到 LOOP 之后的字。我們將在第九課中仔細研究 DO 循環是如何實現的。

Forth 字 I 把索引值從返回棧復制到參數棧頂。因此上面的例子可以解釋如下：

5 / 5

0 / 5 0

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 -- )

I .

2 +LOOP ;

然后你輸入

5 0 looptest

值 0 2 4 將打印出來。

字 +LOOP 從參數棧頂取得值并把它加到返回棧的索引值中，之后的動作與 LOOP 一樣，只要是增量后的索引值小于限值，它就分支到 DO 后面的語句（如果增量值為正）。如果增量的值為負，則當增量的索引值小于限值時就退出循環。例如你可以輸入

: neglooptest ( limit ix -- )

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

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

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

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

___________________________

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 -- )

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>

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

PUSH CX

THEN

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

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 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

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

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

." 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

DUP 2 =

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

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

." 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

." 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

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>=

MOV BX, # FALSE

ELSE

MOV BX, # TRUE

THEN

MOV CX, CS / restore DS

MOV DS, CX

PUSH AX

PUSH BX

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>=

MOV BX, # FALSE

ELSE

MOV BX, # TRUE

THEN

MOV CX, CS / restore DS

MOV DS, CX

PUSH AX

PUSH BX

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

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

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

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 @

2R> 2DROP EXIT

THEN ;

get.next.byte 從磁盤文件中得下一個字節，文件句柄在 handl 中，如果是 eof 則設置變量 eof 為真。

: get.next.byte ( -- byte )

handl @ 1 PAD read.file

FALSE eof ! PAD C@

ELSE

TRUE eof !

THEN ;

get.next.val 從文件中讀出下一個字的值(2 字節)，文件句柄在 handl 中，如果到達文件尾則設置變量 eof 為真，如果文件中存儲的不是 ASCII 碼而是實際的數則這個字就非常有用。

: get.next.val ( -- n )

handl @ 2 PAD read.file

FALSE eof ! PAD @

ELSE

TRUE eof !

THEN ;

get.next.dval 從磁盤文件中讀入 32 位的值(4 字節)，文件句柄在 handl 中。如果文件結束則則設置 eof 變量為真，如果文件中存儲的不是 ASCII 碼而是實際的數則這個字就非常有用。

: get.next.dval ( -- d )

handl @ 4 PAD read.file

FALSE eof ! PAD 2@

ELSE

TRUE eof !

THEN ;

parenchk 如果棧上是一個 '(' 則讀文件直到字符 ')' 被讀入。如果 eof 則退出。

: parenchk ( byte -- byte )

DUP ASCII ( =

DROP

BEGIN

get.next.byte eof?

ASCII ) =

UNTIL

get.next.byte eof?

THEN ;

quotechk 如果堆棧上的字節是引號 (") ，讀入文件直到字節 " 被讀入。如果讀到 eof 則退出。

: quotechk ( byte -- byte )

DUP ASCII " =

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

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

DUP C@ send.byte

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

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

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

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

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

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

END-CODE

得到當前的視頻模式

CODE get.vmode ( -- n )

MOV AH, # 15

INT 16 / current video state

MOV AH, # 0

PUSH AX

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 @ =

DROP 0

THEN

row_select !

movcur

invline ;

: up.curs ( -- )

movcur

invline

row_select @ 1- DUP 0<

DROP no_items @ 1-

THEN

row_select !

movcur

invline ;

每個定義的光標都把下面的值存儲在它的參數字段中

下面這些常數是對應各段的偏移 :

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

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

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 @

." Compiling"

ELSE

." Interpreting"

THEN

CR ;

: 1test ( -- )

1state? ;

你把這個程序裝入然后打入

1state?

和

1test

在每種情況下都是打印出 "interpreting" ，為什么？

因為，當你打印 1state? 和 1test. 時你都是處于解釋狀態。

你怎么才能夠打印出 "Compiling" 呢？這就需要 1state? 在 1test 編譯時執行，也就是說我們必須把 1state? 設計成一個立即字。我們可以通過在 ; 分號之后加一個字 IMMEDIATE 來實現這個目的。讓我們定義

: 2state? ( -- )

STATE @

." Compiling"

ELSE

." Interpreting"

THEN

CR ; IMMEDIATE

現在打入下面的定義

: 2test 2state? ;

注意當你打入這個定義的時候，只要你一按下 <Enter> ， Compiling 就會打印出來。也就是說， 2state? 被立即執行，并不等待你后面打入 2test. 現在打印

2test

注意沒有任何東西打印在屏幕上，這是因為 2state? 沒有被編譯進字典，它只是立即執行。立即字并不被編譯進字典，除非你強制這樣做。你可以強制一個立即字被編譯進字典而不再立即執行，這是通過字 [COMPILE] 實現的。

下面的字定義 3test 是字 2state? 被編譯而不是被執行：

: 3test ( -- )

[COMPILE] 2state? ;

你覺得 3test 會打印什么？試一試。

也可以在冒號定義中使用字 [ 和 ] 來打開或者關閉編譯。 [ 的定義是：

: [ ( -- )

STATE OFF ; IMMEDIATE

字 ] 打開編譯模式并進入編譯循環，編譯循環包括：

從輸入流中得到下一個字，如果這是一個立即字，執行這個字；

否則編譯它；

如果這個字不在字典中，把它轉為一個數字并編譯它 ;

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 )

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 -- )

." True"

ELSE

." False"

THEN ;

: b.test ( -- )

5 0 DO

I .

LOOP ;

: c.test ( -- )

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

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

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

-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

-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

." 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

[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

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

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

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

END-INLINE

1 front +! / inc front

front @ qmax @ > / if front > qmax

qmin @ front ! / then front = qmin

THEN

qbuff.seg @ front @ C@L / get byte

TRUE / set true flag

INLINE

STI / enable interrupts

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

edit_buff $HCREATE

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

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

DROP CR / do a carriage return

ELSE

DUP 32 >= / ignore other control characters

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

?>disk / if data capture on

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

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

$HOPEN

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

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?

KEY DO-KEY

THEN

checkq

?EMIT

THEN

AGAIN ;

總結

以上是生活随笔為你收集整理的Forth语言简明教程的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。

上一篇： div+css静态网页设计——男女装商城
下一篇：优盘扩容修复 u盘工具

编程问答

Forth语言简明教程

Forth 語言簡明教程

趙宇 張文翠 編譯

前言

目錄

第一課 Forth 語言簡介

1.1 介紹 Forth

1.2 Forth 算術

1.3 Forth 算術操作

1.4 堆棧管理字

1.5 更多的 Forth 字

1.6 冒號定義

1.7 練習

第二課 使用 F-PC

2.1 使用 SED 編輯文件

2.2 裝入和運行你的程序

2.3 調試你的程序

2.4 練習

第三課 Forth 是如何工作的

3.1 變量

3.2 關于變量的更多內容 -- FETCH 和 STORE

3.3 常數

3.4 Forth 冒號字義

3.5 數組

3.6 返回棧

3.7 CODE 字

3.8 Forth 字典

3.9 表

3.10 字符和字節數據

3.11 查找字典地址

3.12 名字字段

3.13 F-PC 內層解釋器操作

3.14 練習

第四課 Forth 判斷

4.1 分支指令和循環

4.2 條件字和true/false 標志

4.3 Forth 邏輯操作

4.4 IF 語句

4.5 DO 循環

4.6 UNTIL 循環

4.7 WHILE 循環

4.8 練習

第五課 數

5.1 雙精度數

5.2 雙精度比較操作

5.3 乘法和除法

5.4 向下取整的除法

5.5 16 位操作

5.6 雙精度數的乘法

5.7 練習

第六課 字符串

6.1 字符串輸入

6.2 ASCII – 二進制轉換

6.3 數值輸出轉換

6.4 屏幕輸出

第七課 CODE 字和 DOS I/O

7.1 CODE 字

7.2 CODE 條件

7.3 長存儲器地址字

7.4 DOS 字

7.5 基本的文件 I/O

7.6 讀入數和字符串

7.7 數字和串

第八課 定義字

8.1 CREATE ... DOES>

8.2 一個簡單的跳轉表

8.3 使用任意值的跳轉表

8.4 使用 Forth 字的跳轉表

8.5 彈出式菜單

8.6 練習

第九課 編譯字

9.1 編譯和解釋

9.2 字 COMPILE 和 [COMPILE]

9.3 常數

9.4 條件編譯字

9.5 練習

第十課 Forth 數據結構

10.1 數組

10.2 鏈表

趙宇張文翠編譯

第二課使用 F-PC

第五課數

第六課字符串

第八課定義字

第九課編譯字

第十一課使用中斷的終端程序