\ Lesson 7 - Code Words and DOS I/O
\ The Forth Course
\ by Richard E. Haskell
\ Dept. of Computer Science and Engineering
\ Oakland University, Rochester, MI 48309
comment:
Lesson 7
CODE WORDS AND DOS I/O
7.1 CODE WORDS 7-2
7.2 CODE CONDITIONALS 7-5
7.3 LONG MEMORY WORDS 7-6
7.4 DOS WORDS 7-7
7.5 BASIC FILE I/O 7-9
7.6 READING NUMBERS AND STRINGS 7-14
7.7 WRITING NUMBERS AND STRINGS 7-20
7.1 CODE WORDS
Assembly language instructions can be used to define Forth words
when the maximum speed of execution is needed or when direct access
to the computers hardware is required. This is accomplished by
using the CODE word to define a Forth word. The general form of
the CODE word is as follows:
CODE <name>
<assembly commands>
<return command>
END-CODE
The word CODE takes the place of the colon in a colon definition
and builds a header for the name of the Forth word <name>. The
word END-CODE takes the place of the semi-colon and ends the code
word definition.
The <assembly commands> can be written in either POSTFIX or PREFIX
notation. We recommend PREFIX which makes the assembly language
look very much like standard 8086/8088 assembly language. The
Forth word PREFIX needs to be executed before the CODE word is
compiled.
The <return command> can be any of the following:
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 )
Debugging CODE words is made easier using the 8088 Tutor monitor
that is included with this Forth Course. A complete description
of how to use the Tutor monitor in the process of learning 8088/8086
assembly language is given in the book
"IBM PC - 8088 Assembly Language Programming" by Richard E. Haskell.
Instructions for ordering the book are given when you run the
program.
As an example of using the Tutor monitor to disassemle and
single step through a CODE word consider the following definition
of the Forth word CMOVE that moves a string of <count> bytes from
the address <source> to the address <dest>.
CODE CMOVE ( source dest count -- )
CLD \ move up in memory
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
PUSH ES \ save es
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
POP ES \ restore es
NEST \ done, jmp to >NEXT
END-CODE
When you FLOAD this lesson the following Forth code will store the
hex values 11 22 33 44 55 at the offset address "source.addr" in
the code segment. The actual value of the code segment is given
by the Forth word ?CS: and will be printed on the screen when you
type the word "show.addrs".
A five byte space is reserved at the offset address "dest.addr".
The offset addresses for "source.addr", "dest.addr", the top of
the stack, and the CFA of CMOVE will also be printed on the screen
when you type "show.addrs".
comment;
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 ;
comment:
The words [, ] and LITERAL will be discussed in Lesson 9.
Assume the values printed when you type "show.addrs" are the following:
code segment = E74
source addr = 6929
dest addr = 6931
top of stack = FFE2
address of CMOVE = 41C
Your values may be different. If they are, use your corresponding
values in the following exercise.
Type debug test.
Type test.
Step through the first three word which will put the following
values on the stack:
6929 6931 5
Press F to go to Forth.
Type SYS TUTOR - This will execute the TUTOR program
From the TUTOR memory display
Type >SE74 to display the code segment.
Type /GSE74 to display the data segment = code segment.
Type /GO6929 to display the "source addr" in the data segment.
Note that 11 22 33 44 55 is displayed.
Type /RSSE74 to make the stack segment the same as the code segment.
Type /RPSFEDC to set the stack pointer equal to the
top of stack (FFE2) minus 6.
Type >O41C to go to the start of the CMOVE code.
Single step through this program by pressing key F1.
Note that when you get to the REP instruction, pressing key F1
five times will move the five bytes from "source.addr" to
"dest.addr".
To exit TUTOR, type /QD. This should take you to DOS.
If you had not changed the stack (which you had to do to get
to the values that the Forth program "test" had put on the stack)
then typing /QD from TUTOR will take you back to Forth where you
had typed "sys tutor".
The Forth word CMOVE> ( source dest count -- ) is similar to
CMOVE except that the bytes are moved in the opposite direction.
That is, the highest address byte is moved first. It is necessary
to use this word if you are moving a string up in memory where the
destination string may overlap the source string. The use of CMOVE
will cause the overlapped portion of the source string to be
destroyed before it has a chance to be moved.
7.2 CODE CONDITIONALS
When using the Forth assembler jump instructions are achieved
by using the Forth words IF...ELSE...THEN, BEGIN...WHILE...REPEAT,
and BEGIN...UNTIL together with the following code conditionals:
Forth Assembled Code
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
As an example, consider the definition of the Forth word ?DUP
which duplicates the value on top of the stack only if the value
is non-zero.
CODE ?DUP ( n -- n n | 0 )
POP AX
CMP AX, # 0
0<>
IF
PUSH AX
THEN
1PUSH
END-CODE
Note that when this definition gets assembled into machine code
the statement 0<> is assembled as JE to the instruction following
THEN.
7.3 LONG MEMORY WORDS
The following long memory words are useful for accessing data
in segments other than the code segment.
CODE @L ( seg off -- n ) \ Fetch 16-bit value from seg:off
POP BX \ BX = offset address
POP DS \ DS = segment address
MOV AX, 0[BX] \ AX = data at DS:BX
MOV BX, CS \ Restore DS to CS value
MOV DS, BX
1PUSH \ push value on stack
END-CODE
CODE !L ( n seg off -- ) \ Store 16-bit value at seg:off
POP BX \ BX = offset address
POP DS \ DS = segment address
POP AX \ AX = n
MOV 0[BX],AX \ Store n at DS:BX
MOV BX, CS \ Restore DS to CS value
MOV DS, BX
NEXT
END-CODE
The following are other useful long memory words:
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 WORDS
F-PC has a large number of Forth words for handling DOS file I/O.
These words are defined in the source files HANDLES.SEQ and
SEQREAD.SEQ. In this and the next section we will develop a set
of file I/O words that you can use and extend to handle a variety
of file I/O and other DOS operations. These words can be used
in place of, or in conjunction with, the F-PC DOS and file I/O words.
comment;
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 @ - ;
comment:
{ . . . } Used to keep track of the number of elements
put on the stack. For example,
{ 5 2 8 }
will leave the following values
on the top of the stack:
5 2 8 3
The 3 on top of the stack is the number of
items entered between { and }.
comment;
: $>asciiz ( addr1 -- addr2 ) \ change counted string to ASCIIZ string
DUP C@ SWAP 1+
TUCK +
0 SWAP C! ;
\ DOS 2.0+ disk I/O functions
comment: ----------------------------------------------------------
2fdos calls the DOS INT 21H function with ax=ah:al,
bx, cx and dx on the stack. It returns ax, dx
and an error flag on the stack. If the error flag
is TRUE, the error code is in ax (3rd element on the
stack). If the error flag is FALSE, then ax and dx
will have values that depend on the function call.
fdos is similar to 2fdos, but does not return an error
flag. It should be used for DOS INT 21H calls that
do not use the carry flag to indicate an error.
*******************************************************************
comment;
PREFIX
HEX
CODE 2fdos ( ax bx cx dx -- ax dx f )
POP DX
POP CX
POP BX
POP AX
INT 21 \ DOS function call
U>=
IF \ if carry = 0
MOV BX, # FALSE \ set error flag to false
ELSE \ else
MOV BX, # TRUE \ set error flag to true
THEN
PUSH AX
PUSH DX
PUSH BX
NEXT
END-CODE
CODE fdos ( ax bx cx dx -- ax dx )
POP DX
POP CX
POP BX
POP AX
INT 21 \ DOS function call
PUSH AX
PUSH DX
NEXT
END-CODE
DECIMAL
comment:
7.5 BASIC FILE I/O
The following words can be used for basic file I/O
operations such as opening, creating, closing and
deleting files, as well as reading and writing bytes
from and to the disk file.
-----------------------------------------------------
open.file ( addr -- handle ff | error.code tf )
Opens a file. Returns handle under a false flag
or returns error code under a true flag.
addr points to an asciiz string.
Access code is set to 2 to open for reading and writing.
comment;
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
comment: -----------------------------------------------------
close.file Closes file whose handle is on the stack.
Prints error message if unable to close.
comment;
: close.file ( handle -- )
3E00 \ ah = 3E
SWAP 0 0 \ bx = handle
2fdos
NIP \ nip dx
IF
." Close error number " . ABORT
THEN
DROP ;
comment: -----------------------------------------------------
create.file Creates file -- returns values as in open.file
addr points to an asciiz string
attr is the file attribute: 0 - normal file
01H - read only 02H - hidden
04H - system 08H - volume label
10H - subdirectory 20H - archive
comment;
: create.file ( addr attr -- handle ff | error.code tf )
3C00 \ ah = 3C
0 2SWAP SWAP \ 3C00 0 attr addr
2fdos
NIP ; \ nip dx
comment: ------------------------------------------------------
open/create Opens a file if it exists,
otherwise creates a new normal file.
"addr" points to an asciiz string.
Returns a handle for the opened file.
Prints error messages if unable to open.
comment;
: open/create ( addr -- handle )
DUP open.file
IF
DUP 2 =
IF
DROP 0 create.file
IF ." Create error no. " . ABORT
THEN
ELSE
." Open error no. " . DROP ABORT
THEN
ELSE
NIP
THEN ;
: delete.file ( addr -- ax ff | error.code tf )
4100
0 ROT 0 SWAP
2fdos
NIP ;
: erase.file ( $addr -- ) \ erase file with counted string at $addr
$>asciiz
delete.file
IF
CR ." Delete file error no. " .
ELSE
DROP
THEN ;
comment: -----------------------------------------------------
read.file Reads '#bytes' bytes from file with 'handle'
into buffer at 'buff.addr'. Returns #bytes
actually read. If this value is 0 then the
end of file was read. Prints error message
if unsuccessful.
comment;
: read.file ( handle #bytes buff.addr -- #bytes )
>R 3F00 \ handle #bytes 3F00
-ROT R> \ 3F00 handle #bytes addr
2fdos
NIP \ nip dx
IF
." Read error no. " . ABORT
THEN ;
comment: -----------------------------------------------------
write.file Writes '#bytes' bytes from buffer at 'buff.addr'
to file with 'handle'. Prints error message
if unsuccessful.
comment;
: write.file ( handle #bytes buff.addr -- )
>R 4000 \ handle #bytes 4000
-ROT R> \ 4000 handle #bytes addr
2fdos
NIP \ nip dx
IF
." Write error no. " . ABORT
ELSE
DROP
THEN ;
comment: -------------------------------------------------------
mov.ptr Moves the file pointer of the file with 'handle'.
doffset is a double number (32-bit) offset
code is the method code:
0 - move pointer to start of file + offset
1 - increase pointer by offset
2 - move pointer to end of file + offset
comment;
: mov.ptr ( handle doffset code -- dptr )
42 FLIP + \ hndl offL offH 42cd
ROT >R \ hndl offH 42cd
-ROT R> \ 42cd hndl offH offL
2fdos
IF
DROP ." Move pointer error no. " . ABORT
THEN ;
comment: -------------------------------------------------------
rewind.file Moves the pointer of file with 'handle'
to the start of file.
comment;
: rewind.file ( handle -- )
0 0 0 mov.ptr 2DROP ;
comment: -------------------------------------------------------
get.length Returns the 32-bit length of the file with
'handle'.
comment;
: get.length ( handle -- dlength )
0 0 2 mov.ptr ;
comment: -------------------------------------------------------
read.file.L Reads the next "#bytes" bytes from the opened file
with handle "handle" and stores these bytes in
extended memory at seg:offset.
comment;
CODE read.file.L ( handle #bytes seg offset -- ax f )
POP DX
POP DS
POP CX
POP BX
MOV AH, # 3F
INT 21
U>=
IF
MOV BX, # FALSE
ELSE
MOV BX, # TRUE
THEN
MOV CX, CS \ restore DS
MOV DS, CX
PUSH AX
PUSH BX
NEXT
END-CODE
comment: -------------------------------------------------------
write.file.L Writes "#bytes" bytes from extended memory at
seg:offset to the opened file with handle "handle".
comment;
CODE write.file.L ( handle #bytes seg offset -- ax f )
POP DX
POP DS
POP CX
POP BX
MOV AH, # 40
INT 21
U>=
IF
MOV BX, # FALSE
ELSE
MOV BX, # TRUE
THEN
MOV CX, CS \ restore DS
MOV DS, CX
PUSH AX
PUSH BX
NEXT
END-CODE
comment: -------------------------------------------------------
findfirst.dir Search the directory for the first match of the
file specified by the asciiz string at "addr".
comment;
CODE findfirst.dir ( addr -- f ) \ search directory for first match
POP DX \ dx = addr of asciiz string
PUSH DS \ save ds
MOV AX, CS
MOV DS, AX \ ds = cs
MOV CX, # 10 \ attr includes subdirectories
MOV AX, # 4E00 \ ah = 4E
INT 21 \ DOS function call
JC 1 $ \ if no error
MOV AX, # FF \ flag = TRUE
JMP 2 $ \ else
1 $: MOV AX, # 0 \ flag = FALSE
2 $: POP DS \ restore ds
PUSH AX \ push flag on stack
NEXT
END-CODE
comment: -------------------------------------------------------
findnext.dir Search the directory for the next match of the
file specified by the asciiz string at "addr".
comment;
CODE findnext.dir ( -- f ) \ search directory for next match
PUSH DS \ save ds
MOV AX, CS
MOV DS, AX \ ds = cs
MOV AX, # 4F00 \ ah = 4F
INT 21 \ DOS function call
JC 1 $ \ if no error
MOV AX, # FF \ flag = TRUE
JMP 2 $ \ else
1 $: MOV AX, # 0 \ flag = FALSE
2 $: POP DS \ restore ds
PUSH AX \ push flag on stack
NEXT
END-CODE
comment: -------------------------------------------------------
set-dta.dir Set the disk transfer area address.
comment;
CODE set-dta.dir ( addr -- ) \ set disk transfer area address
POP DX \ dx = dta address
PUSH DS \ save ds
MOV AX, CS
MOV DS, AX \ ds = cs
MOV AX, # 1A00 \ ah = 1A
INT 21 \ DOS function call
POP DS \ restore ds
NEXT
END-CODE
DECIMAL
comment:
7.6 READING NUMBERS AND STRINGS
The following words can be used to read bytes, numbers
and strings from a disk file.
------------------------------------------------------
get.fn enter a filename from the keyboard and
store it as an asciiz string in fname.
comment;
: 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 ;
comment: ------------------------------------------------------
open.filename Enter a filename, open it, and store its
handle in the variable 'handl'.
comment;
: open.filename ( -- )
get.fn
fname open/create
handl ! ;
comment: ------------------------------------------------------
eof? If an end-of-file was read (eof = true)
then exit word containing eof?.
comment;
: eof? ( -- )
eof @
IF
2R> 2DROP EXIT
THEN ;
comment: -------------------------------------------------------
get.next.byte Get the next byte from the disk file
whose handle is in 'handl'.
Sets eof variable to true if eof.
comment;
: get.next.byte ( -- byte )
handl @ 1 PAD read.file
IF
FALSE eof ! PAD C@
ELSE
TRUE eof !
THEN ;
comment: -------------------------------------------------------
get.next.val Read the next 16-bit value (2 bytes) from the
disk file whose handle is in 'handl'.
Sets eof variable to true if eof.
Useful if actual numbers, rather than ASCII data,
is stored on the disk file.
comment;
: get.next.val ( -- n )
handl @ 2 PAD read.file
IF
FALSE eof ! PAD @
ELSE
TRUE eof !
THEN ;
comment: -------------------------------------------------------
get.next.dval Read the next 32-bit value (4 bytes) from the
disk file whose handle is in 'handl'.
Sets eof variable to true if eof.
Useful if actual numbers, rather than ASCII data,
is stored on the disk file.
comment;
: get.next.dval ( -- d )
handl @ 4 PAD read.file
IF
FALSE eof ! PAD 2@
ELSE
TRUE eof !
THEN ;
comment: -------------------------------------------------------
parenchk If the byte on the stack is a '('
read the file until the byte following
the next ')' is read.
Exits if eof is read.
comment;
: parenchk ( byte -- byte )
DUP ASCII ( =
IF
DROP
BEGIN
get.next.byte eof?
ASCII ) =
UNTIL
get.next.byte eof?
THEN ;
comment: -------------------------------------------------------
quotechk If the byte on the stack is a quote (")
read the file until the byte following
the next quote (") is read.
Exits if eof is read.
comment;
: quotechk ( byte -- byte )
DUP ASCII " =
IF
DROP
BEGIN
get.next.byte eof?
ASCII " =
UNTIL
get.next.byte eof?
THEN ;
comment: ------------------------------------------------
?digit Checks to see if the byte on the stack
is the ASCII code of a valid digit in
the current base.
comment;
: ?digit ( byte -- byte f )
DUP BASE @ DIGIT NIP ;
comment: ------------------------------------------------
get.next.digit Gets the next valid ASCII digit
from the disk file.
Exits if eof is read.
comment;
: get.next.digit ( -- digit )
BEGIN
get.next.byte eof?
parenchk eof?
quotechk eof?
?digit NOT
WHILE
DROP
REPEAT ;
comment: ------------------------------------------------
get.digit/minus Gets the next valid ASCII digit
or a minus sign from the disk file.
Exits if eof is read.
comment;
: get.digit/minus ( -- digit or - )
BEGIN
get.next.byte eof?
parenchk eof?
quotechk eof?
DUP ASCII - =
SWAP ?digit ROT OR NOT
WHILE
DROP
REPEAT ;
comment: ---------------------------------------------------
get.next.number gets the next signed integer stored
as an ASCII string on the disk and
converts it to a signed 16-bit integer.
exits if eof is read.
comment;
: 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
comment: ----------------------------------------------------
?period Checks to see if a byte is a period.
Note that the flag is left as the
second element on the stack.
comment;
: ?period ( byte -- f byte )
DUP ASCII . = SWAP ;
comment: ----------------------------------------------------
get.next.dnumber Gets the next signed real number stored
as an ASCII string on the disk and
converts it to a signed double
number on the stack.
The number of digits after the decimal
point is stored in the variable DPL.
Exits if eof is read.
comment;
: 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
comment: ----------------------------------------------------
get.next.string Reads the next string enclosed between
double quotes "....." in the disk file
and stores it as a counted string at "addr".
comment;
: get.next.string ( -- addr ) \ counted string
BEGIN
get.next.byte eof?
ASCII " =
UNTIL
0 PAD 1+
BEGIN \ cnt addr
get.next.byte eof?
DUP ASCII " <>
WHILE
OVER C!
SWAP 1+ SWAP
1+
REPEAT
2DROP PAD C! PAD ;
comment:
7.7 WRITING NUMBERS AND STRINGS
---------------------------------------------------
send.byte Sends a byte to the opened disk file
whose handle is in 'handl'.
comment;
: send.byte ( byte -- )
PAD C!
handl @
1 PAD write.file ;
comment: ---------------------------------------------------
send.number Sends a signed 16-bit number as an
ASCII string to the opened disk file
whose handle is in 'handl'.
comment;
: send.number ( n -- )
(.) 0
DO
DUP C@ send.byte
1+
LOOP
DROP ;
comment: ---------------------------------------------------
send.number.r Sends a signed 16-bit number as an
ASCII string to the opened disk file
whose handle is in 'handl'.
The number will be right-justified in a
field of width "len", padded with leading
ascii blanks.
comment;
: send.number.r ( n l -- )
>R (.) R>
OVER -
0 DO
BL send.byte
LOOP
0 DO
DUP C@ send.byte 1+
LOOP
DROP ;
comment: ---------------------------------------------------
send.dnumber Sends a signed 32-bit number as an
ASCII string to the opened disk file
whose handle is in 'handl'.
The decimal point is positioned according
to the contents of DPL.
comment;
: send.dnumber ( d -- ) \ DPL = #digits after dec. point
TUCK DABS <# DPL @ ?DUP
IF
0 DO # LOOP
ASCII . HOLD
THEN
#S ROT SIGN #>
0 DO
DUP C@ send.byte 1+
LOOP DROP ;
: send.val ( n -- ) \ send 16-bit value
PAD ! handl @
2 PAD write.file ;
: send.dval ( d -- ) \ send 32-bit value
PAD 2! handl @
4 PAD write.file ;
: send.string ( addr -- ) \ addr of counted string
DUP C@
SWAP 1+ SWAP
0 DO
DUP I + C@
send.byte
LOOP
DROP ;
: send.crlf ( -- )
13 send.byte
10 send.byte ;
: send.lf ( -- )
10 send.byte ;
: send.cr ( -- )
13 send.byte ;
: send.tab ( -- )
9 send.byte ;
: send.( ( -- )
ASCII ( send.byte ;
: send.) ( -- )
ASCII ) send.byte ;
: send., ( -- )
ASCII , send.byte ;
: send." ( -- )
ASCII " send.byte ;
: send."string" ( addr -- )
send."
send.string
send." ;