易符建制 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.