📄 86ef202.asm
字号:
TITLE 86eForth
PAGE 62,132 ;62 lines per page, 132 characters per line
;===============================================================
; 86eForth 2.02, C. H. Ting, 06/02/99
; Add create, checksum, UPLOAD and DOWNLOAD.
; A sample session looks like:
; c>86ef202
; DOWNLOAD LESSONS.TXT
; WORDS
; ' THEORY 'BOOT !
; UPLOAD TEST.EXE
; 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 FCD 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
VER EQU 2 ;major release version
EXT EQU 2 ;minor extension
;; Constants
TRUEE EQU -1 ;true flag
COMPO EQU 040H ;lexicon compile only bit
IMEDD EQU 080H ;lexicon immediate bit
MASKK EQU 07F1FH ;lexicon bit mask
CELLL EQU 2 ;size of a cell
BASEE EQU 10 ;default radix
VOCSS EQU 8 ;depth of vocabulary stack
BKSPP EQU 8 ;back space
LF EQU 10 ;line feed
CRR EQU 13 ;carriage return
ERR EQU 27 ;error escape
TIC EQU 39 ;tick
CALLL EQU 0E890H ;NOP CALL opcodes
;; Memory allocation
EM EQU 0FFF0H ;top of memory
US EQU 64*CELLL ;user area size in cells
RTS EQU 128*CELLL ;return stack/TIB size
UPP EQU TIBB-RTS ;start of user area (UP0)
RPP EQU UPP-RTS ;start of return stack (RP0)
TIBB EQU EM-RTS ;terminal input buffer (TIB)
SPP EQU UPP-8*CELLL ;start of data stack (SP0)
COLDD EQU 0 ;cold start vector
;; Initialize assembly variables
_LINK = 0 ;force a null link
_USER = 0 ;first user variable offset
;; Define assembly macros
; Compile a code definition header.
$CODE MACRO LEX,NAME,LABEL
DW _LINK ;;token pointer and link
_LINK = $ ;;link points to a name string
DB LEX,NAME ;;name string
LABEL: ;;assembly label
ENDM
; Compile a colon definition header.
$COLON MACRO LEX,NAME,LABEL
$CODE LEX,NAME,LABEL
CALL DOLST ;;include CALL doLIST
ENDM
; Compile a user variable header.
$USER MACRO LEX,NAME,LABEL
$CODE LEX,NAME,LABEL
CALL DOLST ;;include CALL doLIST
DW DOUSE,_USER ;;followed by doUSER and offset
_USER = _USER+CELLL ;;update user area offset
ENDM
; Assemble inline direct threaded code ending.
$NEXT MACRO
LODSW ;;read the next code address into AX
JMP AX ;;jump directly to the code address
ENDM
;; Main entry points and COLD start data
MAIN SEGMENT
ASSUME CS:MAIN,DS:MAIN,ES:MAIN,SS:MAIN
ORG COLDD ;beginning of cold boot area
ORIG: MOV AX,CS
MOV DS,AX ;all in one segment
CLI ;disable interrupt for old 808x CPU bug
MOV SS,AX
MOV SP,SPP ;initialize SP
STI
MOV BP,RPP ;initialize RP
MOV AL,023H ;^C interrupt Int23
MOV DX,OFFSET CTRLC
MOV AH,025H ;set ^C address
INT 021H
CLD ;SI gets incremented
JMP COLD
; MOV SI,OFFSET COLD1
; $NEXT ;to high level cold start
CTRLC: IRET ;just return from ^C interrupt Int23
; COLD start moves the following to USER variables.
; MUST BE IN SAME ORDER AS USER VARIABLES.
UZERO:
DW BASEE ;BASE
DW 0 ;tmp
DW 0 ;>IN
DW 0 ;#TIB
DW TIBB ;TIB
DW INTER ;'EVAL
DW 0 ;HLD
DW 0 ;CONTEXT pointer
DW CTOP ;CP
DW LASTN ;LAST
ULAST: DW 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;; Device dependent I/O
; All channeled to DOS 21H services
; BYE ( -- )
; Exit eForth.
$CODE 3,'BYE',BYE
MOV AX,04C00H
INT 021H ;MS-DOS terminate process
; ?RX ( -- c T | F )
; Return input character and true, or a false if no input.
$CODE 4,'?KEY',QKEY
XOR BX,BX ;BX=0 setup for false flag
MOV DL,0FFH ;input command
MOV AH,6 ;MS-DOS Direct Console I/O
INT 021H
JZ QRX3 ;?key ready
OR AL,AL ;AL=0 if extended char
JNZ QRX1 ;?extended character code
INT 021H
MOV BH,AL ;extended code in msb
JMP QRX2
QRX1: MOV BL,AL
QRX2: PUSH BX ;save character
MOV BX,TRUEE ;true flag
QRX3: PUSH BX
$NEXT
; TX! ( c -- )
; Send character c to the output device.
$CODE 4,'EMIT',EMIT
POP DX ;char in DL
CMP DL,0FFH ;0FFH is interpreted as input
JNZ TX1 ;do NOT allow input
MOV DL,32 ;change to blank
TX1: MOV AH,6 ;MS-DOS Direct Console I/O
INT 021H ;display character
$NEXT
; open ( fileAccess -- handle )
; Open file. 3D00 read-only, 3D01 write-only.
$CODE 4,'open',OPENF
POP AX
MOV DX, OFFSET ULAST
INT 021H
JC ERROR ;error return -1
PUSH AX
$NEXT
; create ( fileAccess -- handle )
; Create file. 0 read-write, 1 read-only.
$CODE 6,'create',CREATF
POP CX
MOV DX, OFFSET ULAST
MOV AX,5B00H
INT 021H
JC ERROR ;error return -1
PUSH AX
$NEXT
; close ( handle -- )
; Close file.
$CODE 5,'close',CLOSE
POP BX
MOV AX,3E00H
INT 021H
$NEXT
; read ( buffer len handle -- len-read )
; Read file into buffer.
$CODE 4,'read',READF
POP BX
POP CX
POP DX
MOV AX, 3F00H
INT 021H
JC ERROR
PUSH AX
$NEXT
ERROR: MOV AX,-1
PUSH AX
$NEXT
; write ( buffer len handle -- len-writtn )
; Read file into buffer.
$CODE 5,'write',WRITEF
POP BX
POP CX
POP DX
MOV AX, 4000H
INT 021H
JC ERROR
PUSH AX
$NEXT
;; The kernel
; doLIT ( -- w )
; Push an inline literal.
$CODE COMPO+5,'doLit',DOLIT
LODSW
PUSH AX
$NEXT
; doLIST ( a -- )
; Process colon list.
$CODE COMPO+6,'doList',DOLST
XCHG BP,SP ;exchange the return and data stack pointers
PUSH SI ;push on return stack
XCHG BP,SP ;restore the pointers
POP SI ;new list address
$NEXT
; next ( -- )
; Run time code for the single index loop.
; : next ( -- ) \ hilevel model
; r> r> dup if 1 - >r @ >r exit then drop cell+ >r ;
$CODE COMPO+4,'next',DONXT
SUB WORD PTR [BP],1 ;decrement the index
JC NEXT1 ;?decrement below 0
MOV SI,0[SI] ;no, branch back again
$NEXT
NEXT1: INC BP ;yes, pop the index
INC BP
INC SI ;continue past the branch offset
INC SI
$NEXT
; ?branch ( f -- )
; Branch if flag is zero.
$CODE COMPO+7,'?branch',QBRAN
POP BX ;pop flag
OR BX,BX ;?flag=0
JZ BRAN1 ;yes, so branch
INC SI ;point IP to next cell
INC SI
$NEXT
BRAN1: MOV SI,0[SI] ;IP:=(IP)
$NEXT
; branch ( -- )
; Branch to an inline address.
$CODE COMPO+6,'branch',BRAN
MOV SI,0[SI] ;IP:=(IP)
$NEXT
; EXECUTE ( ca -- )
; Execute the word at ca.
$CODE 7,'EXECUTE',EXECU
POP BX
JMP BX ;jump to the code address
; EXIT ( -- )
; Terminate a colon definition.
$CODE 4,'EXIT',EXIT
MOV SI,[BP] ;pop return address
INC BP ;adjust RP
INC BP
$NEXT
; ! ( w a -- )
; Pop the data stack to memory.
$CODE 1,'!',STORE
POP BX
POP 0[BX]
$NEXT
; @ ( a -- w )
; Push memory location to the data stack.
$CODE 1,'@',AT
POP BX
PUSH 0[BX]
$NEXT
; C! ( c b -- )
; Pop the data stack to byte memory.
$CODE 2,'C!',CSTOR
POP BX
POP AX
MOV 0[BX],AL
$NEXT
; C@ ( b -- c )
; Push byte memory location to the data stack.
$CODE 2,'C@',CAT
POP BX
XOR AX,AX ;AX=0 zero the hi byte
MOV AL,0[BX]
PUSH AX
$NEXT
; RP@ ( -- a )
; Push the current RP to the data stack.
$CODE 3,'rp@',RPAT
PUSH BP
$NEXT
; RP! ( a -- )
; Set the return stack pointer.
$CODE COMPO+3,'rp!',RPSTO
POP BP
$NEXT
; R> ( -- w )
; Pop the return stack to the data stack.
$CODE COMPO+2,'R>',RFROM
PUSH 0[BP]
INC BP ;adjust RP
INC BP
$NEXT
; R@ ( -- w )
; Copy top of return stack to the data stack.
$CODE 2,'R@',RAT
PUSH 0[BP]
$NEXT
; >R ( w -- )
; Push the data stack to the return stack.
$CODE COMPO+2,'>R',TOR
DEC BP ;adjust RP
DEC BP
POP 0[BP] ;push
$NEXT
; SP@ ( -- a )
; Push the current data stack pointer.
$CODE 3,'sp@',SPAT
MOV BX,SP ;use BX to index the data stack
PUSH BX
$NEXT
; SP! ( a -- )
; Set the data stack pointer.
$CODE 3,'sp!',SPSTO
POP SP
$NEXT
; DROP ( w -- )
; Discard top stack item.
$CODE 4,'DROP',DROP
INC SP ;adjust SP
INC SP
$NEXT
; DUP ( w -- w w )
; Duplicate the top stack item.
$CODE 3,'DUP',DUPP
MOV BX,SP ;use BX to index the data stack
PUSH 0[BX]
$NEXT
; SWAP ( w1 w2 -- w2 w1 )
; Exchange top two stack items.
$CODE 4,'SWAP',SWAP
POP BX
POP AX
PUSH BX
PUSH AX
$NEXT
; OVER ( w1 w2 -- w1 w2 w1 )
; Copy second stack item to top.
$CODE 4,'OVER',OVER
MOV BX,SP ;use BX to index the stack
PUSH 2[BX]
$NEXT
; 0< ( n -- t )
; Return true if n is negative.
$CODE 2,'0<',ZLESS
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -