易符建制 eForth 2.0 implementation

;     86eForth 2.02, C. H. Ting, 06/02/99

;             c>86ef202

;             86eForth V2.2

;             DOWNLOAD LESSONS.TXT ok

;             ' THEORY 'BOOT ! ok

;             UPLOAD TEST.EXE ok

;             BYE

;             c>test

;     86eForth 2.01, C. H. Ting, 05/24/99

;           Merge Zen2.asm with eForth 1.12

;          1. Eliminate most of the @EXECUTE thru user variables

;          2. Combine name and code dictionary

;          3. Eliminate code pointer fields

;          4. elimiate catch-throw

;          5. eliminate most user variables

;          6. extend top memory to FFF0H where the stacks and user area are.

;          7. add open, close, read, write; improve BYE

;          8. add 1+, 1-, 2/

;

;     eForth 1.12, C. H. Ting, 03/30/99

;             Change READ and LOAD to 'read' and 'load'.

;             Make LOAD to read and compile a file.  The file

;             buffer is from CP+1000 to NP-100.

;             To load all the lessons, type:

;                     LOAD LESSONS.TXT

;             and you can test all the examples in this file.

;

;     eForth 1.11, C. H. Ting, 03/25/99

;             Change BYE to use function 4CH of INT 21H.

;             Add read, write, open, close, READ, and LOAD

;             To read a text file into memory:

;                     HEX 2000 1000 READ TEST.TXT

;             READ returns the number of byte actually read.

;             To compile the source code in the text file:

;                     2000 1000 LOAD

;             where FCD is the length returned by READ.

;             These additions allow code for other eForth systems

;             to be tested on PC first.

;             It is part of the Firmware Engineering Workshop.

;

;   eForth 1.0 by Bill Muench and C. H. Ting, 1990

;           Much of the code is derived from the following sources:

;          8086 figForth by Thomas Newman, 1981 and Joe smith, 1983

;          aFORTH by John Rible

;          bFORTH by Bill Muench

;

;   The goal of this implementation is to provide a simple eForth Model

;   which can be ported easily to many 8, 16, 24 and 32 bit CPU's.

;   The following attributes make it suitable for CPU's of the '90:

;

;       small machine dependent kernel and portable high level code

;       source code in the MASM format

;       direct threaded code

;       separated code and name dictionaries

;       simple vectored terminal and file interface to host computer

;       aligned with the proposed ANS Forth Standard

;       easy upgrade path to optimize for specific CPU

;

;   You are invited to implement this Model on your favorite CPU and

;    contribute it to the eForth Library for public use. You may use

;   a portable implementation to advertise more sophisticated and

;    optimized version for commercial purposes. However, you are

;    expected to implement the Model faithfully. The eForth Working

;   Group reserves the right to reject implementation which deviates

;    significantly from this Model.

;

;   As the ANS Forth Standard is still evolving, this Model will

;   change accordingly. Implementations must state clearly the

;   version number of the Model being tracked.

;

;    Representing the eForth Working Group in the Silicon Valley FIG Chapter.

;   Send contributions to:

;

;      Dr. C. H. Ting

;      156 14th Avenue

;      San Mateo, CA 94402

;       (415) 571-7639

;

;===============================================================

;; Version control

;; Constants

;; Memory allocation

;; Initialize assembly variables

;; Define assembly macros

;           Compile a code definition header.

;           Compile a colon definition header.

;           Compile a user variable header.

;           Assemble inline direct threaded code ending.

;; Main entry points and COLD start data

;          COLD start moves the data to USER variables.

;          MUST BE IN SAME ORDER AS USER VARIABLES.

;; Device dependent I/O

;          All channeled to DOS 21H services

; BYE      ( -- )                                                離開易符

; 001      Exit eForth.

; ?KEY     ( -- c T | F )                                          ?鍵入字符

; 002      Return input character and true, or a false if no input.

; EMIT     ( c -- )                                                印出字符

; 003      Send character c to the output device.

; open     ( fileAccess -- handle )                                開啟檔案

; 004      Open file.  3D00 read-only, 3D01 write-only.

; create    ( fileAccess -- handle )                                建立檔案

; 005      Create file.  0 read-write, 1 read-only.

; close     ( handle -- )                                            關閉檔案

; 006      Close file.

; read     ( buffer len handle -- len-read )                      從檔案讀

; 007      Read file into buffer.

; write     ( buffer len handle -- len-writtn )                      寫到檔案

; 008      Read file into buffer.

;; The kernel

; doLit     ( -- w ) C                                               內碼取值

; 009      Push an inline literal.

; doList    ( a -- ) C                                               內碼執行

; 010      Process colon list.

; next     ( -- ) C                                            內碼逐次返迴

; 011      Run time code for the single index loop.

;   : next ( -- ) \ hilevel model

;     r> r> dup if 1 - >r @ >r exit then drop cell+ >r ;

; ?branch    ( f -- ) C                                              內碼?分岔

; 012      Branch if flag is zero.

; branch    ( -- ) C                                                內碼分岔

; 013      Branch to an inline address.

; EXECUTE    ( ca -- )                                                   執行

; 014      Execute the word at ca.

; EXIT     ( -- )                                                     結束

; 015      Terminate a colon definition.

; !        ( w a -- )                                                      !

; 016      Pop the data stack to memory.

; @        ( a -- w )                                                      @

; 017      Push memory location to the data stack.

; C!       ( c b -- )                                                   存字!

; 018      Pop the data stack to byte memory.

; C@       ( b -- c )                                                    取字@

; 019      Push byte memory location to the data stack.

; rp@      ( -- a )                                            返回堆指標@

; 020      Push the current RP to the data stack.

; rp!      ( a -- )                                              返回堆指標!

; 021      Set the return stack pointer.

; R>       ( -- w )                                                返回堆>

; 022      Pop the return stack to the data stack.

; R@       ( -- w )                                                返回堆@

; 023      Copy top of return stack to the data stack.

; >R       ( w -- )                                                >返回堆

; 024      Push the data stack to the return stack.

; sp@      ( -- a )                                                堆指標@

; 025      Push the current data stack pointer.

; sp!      ( a -- )                                                  堆指標!

; 026      Set the data stack pointer.

; DROP     ( w -- )                                                   丟棄

; 027      Discard top stack item.

; DUP      ( w -- w w )                                             複製

; 028      Duplicate the top stack item.

; SWAP     ( w1 w2 -- w2 w1 )                                          互換

; 029      Exchange top two stack items.

; OVER     ( w1 w2 -- w1 w2 w1 )                                         跳取

; 030      Copy second stack item to top.

; 0<       ( n -- t )                                                    0<

; 031      Return true if n is negative.

; AND      ( w w -- w )                                           必皆是

; 032      Bitwise AND.

; OR       ( w w -- w )                                           非皆否

; 033      Bitwise inclusive OR.

; XOR      ( w w -- w )                                           只其一

; 034      Bitwise exclusive OR.

; UM+      ( u u -- udsum )                                    無號混式+

; 035      Add two unsigned single numbers and return a double sum.

;; System and user variables

; doVar     ( -- a )                                            內碼變數位址

; 036      Run time routine for VARIABLE and CREATE.

; UP       ( -- a )                                                特區指標

; 037      Pointer to the user area.

; doUser    ( -- a ) C                                           內碼特區變數

; 038      Run time routine for user variables.

; BASE     ( -- a ) C                                               數位基底

; 039      Storage of the radix base for numeric I/O.

; tmp      ( -- a )                                                暫存位置

; 040      A temporary storage location used in parse and find.

; >IN      ( -- a )                                            輸入處理指標

; 041      Hold the character pointer while parsing input stream.

; #TIB     ( -- a )                                            輸入字串長度

; 042      Hold the current count in and address of the terminal input buffer.

; 'eval     ( -- a )                                                解譯向量

; 043      Execution vector of EVAL.

; hld      ( -- a )                                            轉碼輸出指標

; 044      Hold a pointer in building a numeric output string.

; CONTEXT    ( -- a )                                            搜尋起始指標

; 045      A area to specify vocabulary search order.

; cp       ( -- a )                                            詞典界限指標

; 046      Point to the top of the code dictionary.

; last     ( -- a )                                                 新詞指標

; 047      Point to the last name in the name dictionary.

;; Common functions

; ?DUP     ( w -- w w | 0 )                                        ?複製

; 048      Dup tos if its is not zero.

; ROT      ( w1 w2 w3 -- w2 w3 w1 )                                    輪轉

; 049      Rot 3rd item to top.

; 2DROP     ( w w -- )                                                雙數丟棄

; 050      Discard two items on stack.

; 2DUP     ( w1 w2 -- w1 w2 w1 w2 )                                   雙數複製

; 051      Duplicate top two items.

; +        ( w w -- sum )                                                  +

; 052      Add top two items.

; NOT      ( w -- w )                                                   否定

; 053      One's complement of tos.

; NEGATE   ( n -- -n )                                                反值

; 054      Two's complement of tos.

; DNEGATE   ( d -- -d )                                            雙數反值

; 055      Two's complement of top double.

; -        ( n1 n2 -- n1-n2 )                                             -

; 056      Subtraction.

; ABS      ( n -- n )                                                  絕對值

; 057      Return the absolute value of n.

; =        ( w w -- t )                                                =

; 058      Return true if top two are equal.

; U<       ( u u -- t )                                            無號<

; 059      Unsigned compare of top two items.

; <        ( n1 n2 -- t )                                             <

; 060      Signed compare of top two items.

; MAX      ( n n -- n )                                           最大值

; 061      Return the greater of two top stack items.

; MIN      ( n n -- n )                                           最小值

; 062      Return the smaller of top two stack items.

; WITHIN    ( u ul uh -- t )                                        範圍內

; 063      Return true if u within the range of ul and uh. ( ul <= u < uh )

;; Divide

; UM/MOD    ( udl udh un -- ur uq )                             無號混式/餘數

; 064      Unsigned divide of a double by a single. Return mod and quotient.

; M/MOD     ( d n -- r q )                                          混式/餘數

; 065      Signed floored divide of double by single. Return mod and quotient.

; /MOD     ( n n -- r q )                                              /餘數

; 066      Signed divide. Return mod and quotient.

; MOD      ( n n -- r )                                                餘數

; 067      Signed divide. Return mod only.

; /        ( n n -- q )                                                /

; 068      Signed divide. Return quotient only.

;; Multiply

; UM*      ( u u -- ud )                                        算無號混式*

; 069      Unsigned multiply. Return double product.

; *        ( n n -- n )                                                *

; 070      Signed multiply. Return single product.

; M*       ( n n -- d )                                            混式*

; 071      Signed multiply. Return double product.

; */MOD     ( n1 n2 n3 -- r q )                                       */餘數

; 072      Multiply n1 and n2, then divide by n3. Return mod and quotient.

; */       ( n1 n2 n3 -- q )                                           */

; 073      Multiply n1 by n2, then divide by n3. Return quotient only.

;; Miscellaneous

; CELL+     ( a -- a )                                               數值寬度+

; 074      Add cell size in byte to address.

; CELL-     ( a -- a )                                               數值寬度-

; 075      Subtract cell size in byte from address.

; CELLS     ( n -- n )                                                數值寬度

; 076      Multiply tos by cell size in bytes.

; 1+       ( a -- a )                                                   1+

; 077      Add cell size in byte to address.

; 1-       ( a -- a )                                                     1-

; 078      Subtract cell size in byte from address.

; 2/       ( n -- n )                                                    2/

; 079      Multiply tos by cell size in bytes.

; BL       ( -- 32 )                                                  空格碼

; 080      Return 32, the blank character.

; >CHAR     ( c -- c )                                                   >符號

; 081      Filter non-printing characters.

; DEPTH     ( -- n )                                                  堆深度

; 082      Return the depth of the data stack.

; PICK     ( ... +n -- ... w )                                      挑取

; 083      Copy the nth stack item to tos.

;; Memory access

; +!       ( n a -- )                                                   +!

; 084      Add n to the contents at address a.

; 2!       ( d a -- )                                                   雙數!

; 085      Store the double integer to address a.

; 2@       ( a -- d )                                                    雙數@

; 086      Fetch double integer from address a.

; COUNT     ( b -- b +n )                                                數算

; 087      Return count byte of a string and add 1 to byte address.

; HERE     ( -- a )                                                詞典界限

; 088      Return the top of the code dictionary.

; PAD      ( -- a )                                                  工作區

; 089      Return the address of the text buffer above the code dictionary.

; TIB      ( -- a )                                                輸入特區

; 090      Return the address of the terminal input buffer.

; @EXECUTE    ( a -- )                                               取向量執行

; 091      Execute vector stored in address a.

; CMOVE     ( b1 b2 u -- )                                            字區搬移

; 092      Copy u bytes from b1 to b2.

; FILL    ( b u c -- )                                                填入

; 093      Fill u bytes of character c to area beginning at b.

; ERASE     ( b u -- )                                                    清除

; 094      Erase u bytes beginning at b.

; PACK$     ( b u a -- a )                                            裝入$

; 095      Build a counted string with u characters from b. Null fill.

;; Numeric output, single precision

; DIGIT     ( u -- c )                                                數碼符號

; 096      Convert digit u to a character.

; EXTRACT    ( n base -- n c )                                轉出最右位數符號

; 097      Extract the least significant digit from n.

; <#       ( -- )                                                    <#

; 098      Initiate the numeric output process.

; HOLD     ( c -- )                                                  加字符

; 099      Insert a character into the numeric output string.

; #        ( u -- u )                                                      #

; 100      Extract one digit from u and append the digit to output string.

; #S       ( u -- 0 )                                                   #數值

; 101      Convert u until all digits are added to the output string.

; SIGN     ( n -- )                                                  加負號

; 102      Add a minus sign to the numeric output string.

; #>       ( w -- b u )                                             #>

; 103      Prepare the output string to be TYPE'd.

; str      ( w -- b u )                                        數值變字串

; 104      Convert a signed integer to a numeric string.

; HEX      ( -- )                                                 十六進制

; 105      Use radix 16 as base for numeric conversions.

; DECIMAL    ( -- )                                                   十進制

; 106      Use radix 10 as base for numeric conversions.

;; Numeric input, single precision

; DIGIT?    ( c base -- u t )                                        數碼符?

; 107      Convert a character to its numeric value. A flag indicates success.

; NUMBER?    ( a -- n T | a F )                                      數值字串?

; 108      Convert a number string to integer. Push a flag on tos.

;; Basic I/O

; KEY      ( -- c )                                                鍵入字符

; 109      Wait for and return an input character.

; NUF?     ( -- t )                                                等一下?

; 110      Return false if no input, else pause and if CR return true.

; SPACE     ( -- )                                                   空一格

; 111      Send the blank character to the output device.

; SPACES    ( +n -- )                                                   空格

; 112      Send n spaces to the output device.

; TYPE     ( b u -- )                                                   $印出

; 113      Output u characters from b.

; CR       ( -- )                                                    新列

; 114      Output a carriage return and a line feed.

; do$      ( -- a ) C                                               內碼取$

; 115      Return the address of a compiled string.

; $"|      ( -- a ) C                                                 內碼$"

; 116      Run time routine compiled by $". Return address of a compiled string.

; ."|      ( -- ) C                                                  內碼."

; 117      Run time routine of ." . Output a compiled string.

; .R      ( n +n -- )                                               .右齊

; 118      Display an integer in a field of n columns, right justified.

; U.R     ( u +n -- )                                            無號.右齊

; 119      Display an unsigned integer in n column, right justified.

; U.       ( u -- )                                                   無號.

; 120      Display an unsigned integer in free format.

; .        ( w -- )                                                       .

; 121      Display an integer in free format, preceeded by a space.

; ?        ( a -- )                                                      ?

; 122      Display the contents in a memory cell.

;; Parsing

; parse     ( b u c -- b u delta ; <string> )                         分字區

; 123      Scan string delimited by c. Return found string and its offset.

; PARSE     ( c -- b u ; <string> )                                分輸入字區

; 124      Scan input stream and return counted string delimited by c.

; .(       ( -- )                                                    .(

; 125      Output following string up to next ) .

; (        ( -- ) I                                                      (

; 126      Ignore following string up to next ) . A comment.

; \        ( -- ) I                                                      \

; 127      Ignore following text till the end of line.

; WORD     ( c -- a ; <string> )                                   輸入字區

; 128      Parse a word from input stream and copy it to code dictionary.

; TOKEN     ( -- a ; <string> )                                  輸入字詞

; 129      Parse a word from input stream and copy it to name dictionary.

;; Dictionary search

; NAME>     ( na -- ca )                                               詞名>

; 130      Return a code address given a name address.

; SAME?     ( a a u -- a a f \ -0+ )                                 比較字串

; 131      Compare u cells in two strings. Return 0 if identical.

; find     ( a va -- ca na | a F )                                   找詞名

; 132      Search a vocabulary for a string. Return ca and na if succeeded.

; NAME?     ( a -- ca na | a F )                                     詞名?

; 133      Search all context vocabularies for a string.

;; Terminal response

; ^h       ( bot eot cur -- bot eot cur )                             退格

; 134      Backup the cursor by one character.

; TAP      ( bot eot cur c -- bot eot cur )                     鍵入處理並回應

; 135      Accept and echo the key stroke and bump the cursor.

; kTAP     ( bot eot cur c -- bot eot cur )                          鍵入處理

; 136      Process a key stroke, CR or backspace.

; ACCEPT    ( b u -- b u )                                          接收到字區

; 137      Accept characters to input buffer. Return with actual count.

; QUERY     ( -- )                                                 接受輸入

; 138      Accept input stream to terminal input buffer.

; ABORT     ( -- )                                                    錯誤

; 139      Reset data stack and jump to QUIT.

; abort"    ( f -- ) C                                              內碼錯誤”

; 140      Run time routine of ABORT" . Abort with a message.

;; The text interpreter

; $INTERPRET    ( a -- )                                               $直譯

; 141      Interpret a word. If failed, try to convert it to an integer.

; [        ( -- )                                                       [

; 142      Start the text interpreter.

; .OK      ( -- )                                                     .是

; 143      Display 'ok' only while interpreting.

; ?STACK    ( -- )                                                     ?堆

; 144      Abort if the data stack underflows.

; EVAL     ( -- )                                                    解譯

; 145      Interpret the input stream.

; PRESET    ( -- )                                                   初始化

; 146      Reset data stack pointer and the terminal input buffer.

; QUIT     ( -- )                                                    辭職

; 147      Reset return stack pointer and start text interpreter.

;; The compiler

; '        ( -- ca )                                                      ‘

; 148      Search context vocabularies for the next word in input stream.

; ALLOT     ( n -- )                                                   預留

; 149      Allocate n bytes to the code dictionary.

; ,        ( w -- )                                                      ,

; 150      Compile an integer into the code dictionary.

; [COMPILE]    ( -- ; <string> ) I C                                  [編譯]

; 151      Compile the next immediate word into code dictionary.

; COMPILE    ( -- )                                                    編譯

; 152      Compile the next address in colon list to code dictionary.

; LITERAL    ( w -- ) I C                                         取數編入

; 153      Compile tos to code dictionary as an integer literal.

; $,"      ( -- )                                                    $,”

; 154      Compile a literal string up to next " .

;; Structures

; FOR      ( -- a ) I C                                         逐次起始

; 155      Start a FOR-NEXT loop structure in a colon definition.

; BEGIN     ( -- a ) I C                                             起始

; 156      Start an infinite or indefinite loop structure.

; NEXT     ( a -- ) I C                                         逐次返迴

; 157      Terminate a FOR-NEXT loop structure.

; UNTIL     ( a -- ) I C                                         否則返迴

; 158      Terminate a BEGIN-UNTIL indefinite loop structure.

; AGAIN     ( a -- ) I C                                         永遠返迴

; 159      Terminate a BEGIN-AGAIN infinite loop structure.

; IF       ( -- A ) I C                                             若則

; 160      Begin a conditional branch structure.

; AHEAD     ( -- A ) C                                                  前去

; 161      Compile a forward branch instruction.

; REPEAT    ( A a -- ) I C                                             返迴

; 162      Terminate a BEGIN-WHILE-REPEAT indefinite loop.

; THEN     ( A -- ) I C                                             然後

; 163      Terminate a conditional branch structure.

; AFT      ( a -- a A ) I C                                     首次若則

; 164      Jump to THEN in a FOR-AFT-THEN-NEXT loop the first time through.

; ELSE     ( A -- A ) I C                                             否則

; 165      Start the false clause in an IF-ELSE-THEN structure.

; WHILE     ( a -- A a ) I C                                       若發生

; 166      Conditional branch out of a BEGIN-WHILE-REPEAT loop.

; ABORT"    ( -- ; <string> ) I C                                       錯誤”

; 167      Conditional abort with an error message.

; $"       ( -- ; <string> ) I C                                       $”

; 168      Compile an inline string literal.

; ."       ( -- ; <string> ) I C                                       .”

; 169      Compile an inline string literal to be typed out at run time.

;; Name compiler

; ?UNIQUE    ( a -- a )                                                   ?重複

; 170      Display a warning message if the word already exists.

; $,n      ( na -- )                                                  建詞名

; 171      Build a new dictionary name using the string at na.

;; FORTH compiler

; $COMPILE    ( a -- )                                                   $編譯

; 172      Compile next word to code dictionary as a token or literal.

; OVERT     ( -- )                                                   入詞典

; 173      Link a new word into the current vocabulary.

; ;        ( -- ) I C                                                     ;

; 174      Terminate a colon definition.

; ]         ( -- )                                                       ]

; 175      Start compiling the words in the input stream.

; call,     ( ca -- ) C                                              呼叫,

; 176      Assemble a call instruction to ca.

; :         ( -- ; <string> )                                            :

; 177      Start a new colon definition using next word as its name.

; IMMEDIATE    ( -- )                                                 即時

; 178      Make the last compiled word an immediate word.

;; Defining words

; CREATE    ( -- ; <string> )                                        建新詞

; 179      Compile a new array entry without allocating code space.

; VARIABLE    ( -- ; <string> )                                         變數

; 180      Compile a new variable initialized to 0.

;; Tools

; _TYPE     ( b u -- )                                            過濾字區印出

; 181      Display a string. Filter non-printing characters.

; dm+      ( a u -- a )                                            傾印+

; 182      Dump u bytes from , leaving a+u on the stack.

; DUMP     ( a u -- )                                                    傾印

; 183      Dump u bytes from a, in a formatted manner.

; .S       ( ... -- ... )                                               .堆

; 184      Display the contents of the data stack.

; >NAME     ( ca -- na | F )                                           >詞名

; 185      Convert code address to a name address.

; .ID      ( na -- )                                                   .詞名

; 186      Display the name at address.

; SEE      ( -- ; <word> )                                          看定義

; 187      A simple decompiler. Updated for byte machines, 08mar98cht

; WORDS     ( -- )                                                   看詞彙

; 188      Display the names in the context vocabulary.

; READ     ( bufffer len -- len-read , <filename> )               讀進檔案

; 189      Open a file by name and load it into buffer.

; LOAD     ( buffer len -- )                                        字區載入

; 190      Load file read into the buffer.

; DOWNLOAD    ( -- , <filename> )                                     下載檔案

; 191      Load file read into the buffer.

; checksum    ( addr len -- sum )                                     字區檢驗

; 192      Add words to form 16-bit sum. len must be even.

; UPLOAD    ( -- , <filename> )                                     系統上傳

; 193      Save current image to an EXE file.

;; Hardware reset

; hi       ( -- )                                                 易符招呼

; 194      Display the sign-on message of eForth.

; 'BOOT     ( -- a )                                                起動向量

; 195      The application startup vector.

; COLD     ( -- )                                                 冷機起動

; 196      The hilevel cold start sequence.

This is the end of the document.