Codeing changed to suit COLDFORTH standards by Charles Esson.
Cross compiler support for struc added by Charles Esson.
Data structures (like C structs)
This file retains M.Anton Ertl copyright: This file is in the public domain. NO WARRANTY.
You can define a structure for a (data-less) linked list with
struct cell% field list_next end_struct list%
With the address of the list node on the stack, you can compute the address of the field that contains the address of the next node with list-next. E.g., you can determine the length of a list with the code:
\ "list" is a pointer to the first element of a linked list \ "n" is the length of the list : list-length ( list -- n ) 0 BEGIN ( list1 n1 ) OVER WHILE ( list1 n1 ) 1+ SWAP list_next @ SWAP REPEAT NIP ;
You can reserve memory for a list node in the dictionary with:
list% %allot
This leaves the address of the list node on the stack. For the equivalent allocation on the heap you can use:
list% struct_alloc
For an allocate-like stack effect (i.e., with ior), use:
list% struct_allocate
You can also include a structure foo% as field of another structure, with:
struct ... foo% field ... ... end_struct ...
Instead of starting with an empty structure, you can also extend an existing structure. E.g., a plain linked list without data, as defined above, is hardly useful; You can extend it to a linked list of integers, as follows:
list% cell% field intlist_int end_struct intlist%
intlist% is a structure with two fields: list_next and intlist_int.
This feature is also known as extended records. It is the main innovation in the Oberon language; in other words, adding this feature to Modula-2 led Wirth to create a new language, write a new compiler etc. Adding this feature to Forth just requires a few lines of code.
You can specify an array type containing n elements of type foo% like this:
foo% n *
This code will supply alignment and size.You can use this array type in any place where you can use a normal type, e.g., when defining a field, or with %allot.
The first field is at the base address of a structure and the word for this field (e.g., list-next) actually does not change the address on the stack. You may be tempted to leave it away in the interest of run-time and space efficiency. This is not necessary, because the structure package optimizes this case and compiling such words does not generate any code. So, in the interest of readability and maintainability you should include the word for the field when accessing the field.
The central idea in the implementation is to pass the data about the structure being built on the stack, not in some global variable. Everything else falls into place naturally once this design decision is made.
The type description on the stack is of the form ( align size --) Keeping the size on the top-of-stack makes dealing with arrays very simple.
field is a defining word that uses CREATE and DOES>. The body of the field contains the offset of the field, and the normal DOES> action is @ +. That is add the offset to the address, giving the stack effect ( addr1 -- addr2 ) for a field child word.
This simple structure is slightly complicated by the optimization for fields with offset 0, which requires a different DOES> part (because we cannot rely on there being something on the stack if such a field is invoked during compilation). Therefore, we put the different DOES> parts in separate words, and decide which one to invoke based on the offset. For a zero offset, the field is basically a noop; it is immediate, and therefore no code is generated when it is compiled.
xaddr_aligned is the aligned version of addr1 with the alignment size n
: _n_align ( addr1 n -- addr_aligned )
1-
TUCK \ n addr1 n(--
+
SWAP \ addr2 n(--
INVERT \ addr2 -n(--
AND \ addr1_aligned(--
;
\ for the xcompiler
forth : _n_align ( addr1 n -- addr_aligned )
forth 1-
TUCK \ n addr1 n(--
+
SWAP \ addr2 n(--
INVERT \ addr2 -n(--
AND \ addr1_aligned(--
;
HOST
Runtime for field, two different version, one for when the offset is zero. One for all other cases.
: _do_field ( -- )
DOES> ( name execution: addr1 -- addr2 )
@ +
;
\ for the xcompiler
forth : _do_field ( n -- )
HOST
\ This lays down the action of the child word in the target
_recover_cfa
2016 tw, \ ##code S ) D0 MOV
0680 tw, \ ##code n # D0 ADD
t,
2C80 tw, \ ##code D0 S ) MOV
4E75 tw, \ ##code RTS
\ This lays down the action of the child word in the host.
\ As structures have to available to the target compiler it
\ has to be this way.
forth
DOES> ( name execution: addr1 -- addr2 )
@ +
;
HOST
: _do_zero_field ( -- )
IMMEDIATE
DOES> ( name execution: -- )
DROP
;
.S .( _do_zero_field )
forth : _do_zero_field ( -- )
HOST _recover_cfa
4E75 tw, \ ##code RTS
inline \ Tell system child word is pure code, in fact no code.
forth
DOES>
DROP
;
HOST
Create the fields head and body, perform the stack manipulation required as fields are defined. Or in other words fields compile time action. This word is used in the object.html file.
: _create_field ( align1 offset1 align size "name" -- align_out offset_out )
CREATE \ align1 offset1 align size(--
SWAP \ align1 offset1 size align(--
ROT \ align1 size align offset(--
OVER \ align1 size align offset align(--
_n_align \ align1 size align offset2(--
DUP , \ align1 size align offset2(--
ROT \ align1 align offset2 size(--
+ \ align1 align offset3(--
>R
_n_align \ align2(--
R> \ align2 offset3(--
;
\ for the xcompiler
forth : _create_field ( align1 offset1 align size "name" -- align_out offset_out )
HOST CREATE \ align1 offset1 align size(--
forth SWAP \ align1 offset1 size align(--
ROT \ align1 size align offset1(--
OVER \ align1 size align offset1 align(--
HOST _n_align \ align1 size align offset2(--
forth DUP
\ for the host version
\ horible kludge requiring knowedge of the cross compiler
\ recovering the constant_host value
forth -4 ALLOT
forth , \ align1 size align offset2(--
ROT \ align1 align offset2 size(--
+ \ align1 align offset3(--
>R
HOST _n_align \ align2(--
forth R> \ align2 offset3(--
;
HOST
Used between struct and end_struct. field creates a child work that adds the fields offset onto the top stack item.
: field \ parent ( align1 offset1 align size "name" -- align2 offset2 )
\ child ( addr1 -- addr2)
jump \ align1 offset1 align size offset1(--
>R \ this uglyness is just for optimizing
\ with _do_zero_field
_create_field
R> IF \ offset<>0
_do_field
ELSE
_do_zero_field
THEN
;
\ for the xcompiler
forth : field \ parent ( align1 offset1 align size "name" -- align2 offset2 )
\ child ( addr1 -- addr2)
forth jump \ align1 offset1 align size offset1(--
>R \ this uglyness is just for optimizing
\ with _do_zero_field
HOST _create_field
forth R> ?DUP IF \ offset<>0
HOST _do_field
forth ELSE
HOST _do_zero_field
forth THEN
;
HOST
Used at the end of a structure, creates a child word that returns the alignment of the structure and the size of the stucture
: end_struct \ parent ( align size "name" -- )
\ child ( -- align size)
OVER _n_align \ pad size to full alignment
2CONSTANT
;
\ for the xcompiler
forth : end_struct \ parent ( align size "name" -- )
\ child ( -- align size)
forth OVER
HOST _n_align \ pad size to full alignment
HOST 2CONSTANT
forth
;
HOST
A null strcuture is used to start the structure, however the structure can be started with any other structure.
\ This creates a host and target version
1 0 end_struct struct
The basis data types return their alignment and size.
1 1 2CONSTANT byte%
1 ALIGNED 2 2CONSTANT word%
1 ALIGNED 1 CELLS 2CONSTANT cell%
1 CHARS 1 CHARS 2CONSTANT char%
1 ALIGNED 2 CELLS 2CONSTANT double%
: bytes% ( n -- 1 n )
1 SWAP
;
forth : bytes% ( n -- 1 n )
1 SWAP
;
HOST
: struct_alignment ( align size -- align )
DROP
;
: struct_size ( align size -- size )
NIP
;
Allocate a structure in the ram space. One version for kernel runtime, another version for xcompile time.
: _ram_align ( align size -- )
DROP \ align
ram_here \ align here(--
SWAP \ here align(--
_n_align \ alighned_here(--
ram_here
- \ number_of_bytes(--
ram_allot
;
: struct_ram_allot ( align size -- addr )
TUCK \ size align size(--
_ram_align \ size(--
ram_here
SWAP \ here size(--
ram_allot
;
\ allocation of ram space when compiling kernel
forth : _ram_align ( align size -- )
forth DROP \ align
HOST ram_here \ align here(--
forth SWAP \ here align(--
HOST _n_align \ alighned_here(--
HOST ram_here
forth - \ number_of_bytes(--
HOST ram_allot
forth
;
HOST
forth : struct_ram_allot ( align size -- addr )
forth TUCK \ size align size(--
HOST _ram_align \ size(--
HOST ram_here
forth SWAP \ here size(--
HOST ram_allot
forth
;
HOST
Allocate a structure in the dictioanry space. One version for kernel runtime, another version for xcompile time.
These should only be used if you want to preset the data at compile time. Remeber the dictionary is a limited resource using it it for data areas that don't have to be preset is a waste of the resource.
: _struct_align ( align size -- )
DROP \ align
HERE \ align here(--
SWAP \ here align(--
_n_align \ alighned_here(--
HERE
- \ number_of_bytes(--
ALLOT
;
: struct_allot ( align size -- addr )
TUCK \ size align size(--
_struct_align \ size(--
HERE
SWAP \ here size(--
ALLOT
;
\ for allocation of dictionary space when compiling kernel
forth : _struct_align ( align size -- )
forth DROP \ align
HOST HERE \ align here(--
forth SWAP \ here align(--
HOST _n_align \ alighned_here(--
HOST HERE
forth - \ number_of_bytes(--
HOST ALLOT
forth
;
HOST
forth : struct_allot ( align size -- addr )
forth TUCK \ size align size(--
HOST _struct_align \ size(--
HOST HERE
forth SWAP \ here size(--
HOST ALLOT
forth
;
HOST
.S .( struct_allot)
Allocate a structure from the heap. This has no meaning at xcompile time.
: struct_allocate ( align size -- addr ior )
NIP ALLOCATE
;
: struct_heap_allot ( align align-- addr )
struct_allocate THROW
;
\ No use creating on heap if we can't destroy it
: struct_free ( addr -- ior )
FREE
;
: struct_heap_free ( addr -- )
struct_free THROW
;