\ Lesson 10 - Forth Data Structures
\ The Forth Course
\ by Richard E. Haskell
\ Dept. of Computer Science and Engineering
\ Oakland University, Rochester, MI 48309
comment:
Lesson 10
FORTH DATA STRUCTURES
10.1 ARRAYS 10-2
10.2 LINKED LISTS 10-5
10.3 RECORDS 10-13
10.1 ARRAYS
Much of the information in this lesson is based on material found
in the book "Object-oriented Forth" by Dick Pountain, Academic
Press, 1987. We will extend those ideas so that the data structures
can take advantage of all of the memory in the system.
The F-PC words ALLOC ( #para -- #para segment flag )
and DEALLOC ( segment -- flag ) use the DOS function calls
AH = 48H and AH = 49 respectively to allocate and release memory.
Using these words we can define the following more convenient
words to allocate and release memory:
comment;
: 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 "
;
comment:
The word alloc.mem expects the size of the block you want to
allocate (in bytes) on the stack and returns the segment address
of the allocated block. The F-PC word
: PARAGRAPH 15 + U/16 ;
will convert the number of bytes requested to the number of
16-byte paragraphs.
The word release.mem will release the memory allocated by alloc.mem.
You must first push on the stack the segment address of the block
of memory you want to release. (This must be the segment address
returned by a previous call of alloc.mem).
Suppose you want to create an array of a certain size in extended
memory and then use @L and !L to fetch and store values in this
array. We might define the following defining word:
comment;
: array ( size +++ )
CREATE
2* DUP alloc.mem , \ save seg address
, \ save array size in bytes
DOES>
@ ;
comment:
Then, for example,
1000 array array.name
will create a dictionary entry called array.name, allocate 1000
words of memory and store the segment address of the allocated
block of memory and the size of the array in the parameter field
of array.name. When array.name is later called it will leave the
segment address of the array on the stack. The dictionary entry
of array.name will be stored in memory as follows:
array.name
________ |
CFA | CODE | <------|
|------| ________
PFA | seg | ----------------------> | | seg:0
|------| |------|
| size | | |
|------| |------|
Code Segment ?CS: | |
|------|
| |
|------|
| |
|------|
Array Segment
To access the value of the array element array.name(5), for example,
you would type
array.name 5 @L
The problem with using this scheme for extended memory arrays is
that it will fail if you make a turnkey system of your program.
Making a turnkey system will strip all headers from the dictionary
and create an .EXE file that contains all of your program words
together with all the F-PC words. When you save this system the
code segment part of any arrays that you have defined will be saved
but the memory allocated for the actual array will be lost. This
means that when the turnkey program later runs it must somehow
allocate any memory it needs for arrays and store the segment
address of the array in the PFA of the array name.
We can modify the definition of array to be used in turnkey systems
as follows:
comment;
: array.tk ( size +++ )
CREATE
0 , \ fill in seg address later
2* , \ save array size in bytes
DOES>
@ ;
\ Note that if you now type
1000 array.tk array.name
comment:
you will create the dictionary entry array.name and save the size
of 1000 but will not allocate any memory for the array at this point.
Memory can later be allocated for all arrays using the following
words:
comment;
: 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 ;
comment:
The word allocate.arrays would contain a similar line for each
array that you had defined in the program. You would include
the word allocate.arrays as part of the initiallization of your
program. This will allow memory to be allocated for each of your
arrays even in turnkey systems.
You can release all memory allocated to arrays using the following
words:
comment;
: release.array ( cfa -- )
>BODY @ \ get segment address
release.mem ; \ and release it
: release.all.arrays ( -- )
[ ' array.name ] LITERAL release.array ;
comment:
You would add similar lines to release.all.arrays for each array
whose memory you want to release.
10.2 LINKED LISTS
In this section we will write a number of words for creating and
maintaining linked lists. (See Chapter 3 in Pountain's book).
Each node in the linked list will contain 4 bytes. The first two
will be a pointer to the next node and the last two will contain
the 16-bit value associated with the node.
_____________ _____________ _____________
| ptr |value| | ptr |value| | 0 |value|
------------- ------------- -------------
| ^ | ^
| | | |
|---------------| |---------------|
When adding values from a given linked list we will get a node
from a large pool of nodes in a free list and when we delete a
value from a list we will return the node to the free list. We
will allocate a large block of memory for the free list and then
link all of the nodes in the free list as follows:
_________
| | <list.seg>:0
|-------|
| head^ |--| :2
|-------| |
|--| ptr |<-| :4
| |-------|
| | value |
| |-------|
|->| ptr |--| :8
|-------| |
| value | |
|-------| |
|--| ptr |<-| :12
| |-------|
| | value |
| |-------|
|->| ptr |--| :16
|-------| |
| value | |
|-------| |
| ptr |<-|
|-------|
Available nodes start at offset address 4 within the segment
<list.seg> and occur at multiples of 4 bytes thereafter. The
head pointer of the free list is at address <list.seg>:2. The
value at <list.seg>:0 is not used. The following words will
create this free list.
comment;
\ ------------------------------------------------------
\ Variables and Constants
DECIMAL
0 CONSTANT nil
2 CONSTANT [freelist.head]
0 VALUE <list.seg>
[freelist.head] VALUE [list.offset]
\ ------------------------------------------------------
\ Allocate memory
: release.seglist ( -- )
<list.seg> ?DUP
IF
DEALLOC 0= \ DOS INT 21H - AH=49H
IF
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
\ ------------------------------------------------------
\ Create freelist
\ 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] ;
\ ------------------------------------------------------
\ Node manipulation words
\ The following word will insert a node at address seg:node
\ after a node whose pointer is at address 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 ;
\ The following word will remove the node following the pointer at
\ seg:list and leave the address of the removed node, seg:node,
\ on the stack. If seg:list is the header, this word removes the
\ first node in the list. If the list is empty, it leaves 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 ;
\ To get a node you just remove one from the free list using getnode.
: getnode ( --- seg node )
freelist node.remove ;
\ To put a node at seg:node back in the free list you use freenode.
: freenode ( seg node --- )
freelist 2SWAP \ seg list seg node
node.insert ;
\ The word newlist will create a new list header in the code segment.
\ The PFA of this list header will contain the offset address in the
\ segment <list.seg> of the list header.
: newlist ( +++ )
CREATE
nil , \ fill in node addr later
DOES> ( -- seg list )
<list.seg> SWAP @ ;
\ To create a new list called sample.list you would type
newlist sample.list
\ You would then create the header for this list in the segment
\ <list.seg> by including the following line in the word
\ fill.newlists.
: fill.newlists ( -- )
getnode DUP [ ' sample.list ] LITERAL >BODY ! nil -ROT !L ;
comment:
This technique is used to make the lists available in a turnkey
system in much the same way we did it for arrays. Before you can
use any of these data structures you must allocate the memory in
your program using a word such as
comment;
: init.data.structures ( -- )
allocate.arrays
1200 allocate.freelist
fill.newlists ;
\ So that you can test the words in this lesson we will go ahead
\ and execute
init.data.structures
\ when you FLOAD LESSON10.
\ To push the value 5 on the top of the list sample.list you would type
\ 5 sample.list push
\ using the following word 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 ;
\ To pop the top value from the list sample.list you would type
\ sample.list pop
\ using the following word 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 ;
\ To print out the contents of the list sample.list you would type
\ sample.list .all
\ using the following word .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 ;
\ To reclaim all of the nodes in sample.list you would type
\ sample.list kill
\ using the following word 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 ;
\ -------------------------------------------------------------
\ List tests
\ The following word will check to see if a particular value is
\ in a list. For example,
\ 5 sample.list ?in.list
\ will return a true flag over the 5 if the value 5 is in the list.
: ?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
\ The word ?pop can be used to pop the top of the list if the list
\ is not empty. If the list is empty, this word leaves a false flag
\ on top of the stack. This word is useful if you are not sure when
\ the list will be empty and you don't want to abort if it is.
: ?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 ;
\ The word ?list.empty will return a true flag if the list is 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 ;
\ The word findpos< will find the position of the node after which
\ to insert a value so that values will be stored in the list
\ in ascending order. For example, to insert the value 35 into the
\ list sample.list so that the list is maintained in ascending order
\ you would type
\ 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
IF
-ROT EXIT \ v s l
THEN \ s l v
-ROT OVER SWAP @L \ v s n
REPEAT
-ROT ; \ v s l
\ The word findpos> will find the position of the node after which
\ to insert a value so that values will be stored in the list
\ in descending order. For example, to insert the value 35 into the
\ list sample.list so that the list is maintained in descending order
\ you would type
\ 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
IF
-ROT EXIT \ v s l
THEN \ s l v
-ROT OVER SWAP @L \ v s n
REPEAT
-ROT ; \ v s l
\ The following word can be used to find the address of the
\ nth node in a list. For example, to get the value in the
\ 5th node of the list sample.list you would type
\ 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
IF
." Beyond list end " ABORT
THEN
LOOP \ s n
THEN ; \ s l if n=0
\ The following word can be used to find the number of nodes in
\ a list. For example,
\ sample.list get.#nodes .
\ will print the number of nodes in the list 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
comment:
10.3 RECORDS
For a discussion of Forth records see Chapter 1 in the Pountain
book. The following examples are based on information in that
chapter.
The words in this section can be used to produce a rather flexible
linked record system in which each record is a separate segment in
memory and these records can be linked by pointers which are fields
in the record. Any number of different record types can be defined
and any number of record instances can be created and linked to the
entire structure in a hierarchical system. The various field in a
given record can be of varying size.
We will illustrate the use of these record words by considering
a simple example of a student record system. Each student will
be assigned the following record:
________
sr.head:0 | ^SR |-----|
|------| |
| ___________
|------> | size | <SR.NODE>:0
|---------|
| ^next | <SR.NODE> [NEXT.SR]
|---------|
| ^name | <SR.NODE> [NAME.SR]
|---------|
| ^addr | <SR.NODE> [ADDR.SR]
|---------|
| ^data | <SR.NODE> [DATA.SR]
|---------|
The header sr.head:0 contains the segment address of the first
student record. The first element in the <SR.NODE> segment contains
the number of fields in the current record. The first field at
offset address [NEXT.SR] contains a pointer (segment address) to
the next student record. The second field at offset address
[NAME.SR] contains a pointer to a segment containing the student's
the next student record. The third field at offset address
[ADDR.SR] contains a pointer (segment address) to an address
record. This record might contain separate fields for street,
city, state and zip code. The fourth field at offset address
[DATA.SR] contains a pointer (segment address) to an data
record. This record might contain various fields for data such
as sex, age, class, major, GPA, or any other information.
These records can be created with the following words:
VARIABLE total.bytes 2 total.bytes !
\ Declare a field name
: field ( n +++ )
CREATE
total.bytes @ , \ store offset
total.bytes +! \ bump offset count
IMMEDIATE
DOES> ( seg pfa -- seg off )
@ \ get field address
STATE @ \ if compiling
IF
[COMPILE] LITERAL \ ...bind early
THEN ;
\ Make an instance of a record type (internal use only)
: 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 ;
\ Create the record defining word
: 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 ;
\ The following fields are offset addresses into the sr node
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
Note that the word field is a defining word that defines names
corresponding to the offset addresses in the student record
<SR.NODE>. When these words are created the value in the
variable total.bytes is stored in the PFA of the created word
and then the value of total.bytes in incremented by the value
on the stack when field is called. (Note that total.bytes starts
with an initial value of 2). This technique will produce the
correct offset addresses for fields of different width. Fields
can also be added or subtracted without having to worry about
changing the offset addresses.
The statement
define-record SR-REC
will now create a word called SR-REC that itself is used later
to create instances of a student record.
To complete the example, suppose we define the following records:
\ The following fields are offsets into the student data node
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
\ The following field is an offset addr of the name node
24 field [NAME.FN] \ student name - counted string
define-record NAME-REC
\ The following fields are offset addresses into the address node
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
\ The following words are used to create and delete a student record:
: >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
IF
BEGIN
DUP [NEXT.SR] @L
SWAP release1.SR ?DUP
WHILE
REPEAT
0 -ROT !L
THEN
zero.<nodes> ;
comment:
To add a record you would type
sr.list make.SR.record
You could then add data to the various fields either from the
keyboard or from another disk file. For example,
345 <NODE.DATA> [MAJOR.D] !L
will store the value of 345 in the appropriate major field.
comment;