(       Title:  Plain Structures 200x
         File:  plainstruct-200x.fs
      Version:  1.0.0
      Adaptor:  David N. Williams
      License:  Public Domain?
     Log file:  plainstruct-200x.log
Last revision:  August 1, 2008

This library is based on common practice for structure words. 
In particular, it goes back to Mitch Bradley's article,
"Structured Data with Bitfields", undated but with "recent"
references to articles written in 1983.  Much of that practice
has been proposed for the Forth 200x standard:

  http://www.forth200x.org/structures.html

Words in this library that are also in the proposal are marked
"200x".

The "Plain" in "Plain Structures" refers to the absence of
naming for definitions of structures.  Actually that's not quite
true.  The naming function of BEGIN-STRUCTURE ... END-STRUCTURE
in the proposal is performed here by STRUCT ... /STRUCT:, which
names the structure size explicitly instead of naming the
structure and having that name return the size.

The code is ANS Forth compatible except for case sensitivity.
)

decimal


\ *** WORDS
(
  STRUCT  /STRUCT:
  +FIELD  cfield:  field:  2field:  sfield:
  ffield:  sffield:  dffield:
)


\ *** UNNAMED STRUCTURES
(
Structure access syntax resolves to the form:

  <address> <offset+> <fetch|store>

Structures are defined without names.  Field and structure size
names are not reusable.  Explicit sprinkling of ALIGNED may be
required.  With appropriate alignment, structures are nestable.
Structure instances may be named or not.

Note that structure definitions that do not create a structure
size word with /STRUCT: need to terminate with some other word
that removes the running offset from the stack, like DROP.

See the next section for syntax examples.
)

: STRUCT  ( -- 0 )  0 ;

: /STRUCT:  ( "sizename" u -- )  aligned constant ;

: +FIELD  ( offset size <"name"> -- offset+size )  \ 200x
  create over , +
DOES>  ( struc -- struc+offset )  @ + ;

: cfield:  ( offset <"name"> -- offset+1char )  \ 200x
\ Exec:    ( struc -- struc+offset )
  1 chars +FIELD ;

: field:  ( offset <"name">  -- offset+1cell )  \ 200x
\ Exec:   ( struc -- struc+offset )
  aligned 1 cells +FIELD ;

: 2field:  ( offset  -- offset+2cells )  \ gforth
\ Exec:    ( struc -- struc+offset )    
  2 cells + +FIELD ;

: sfield:  ( offset  -- offset+2cells )
\ Exec:    ( struc -- struc+offset )    
  2 cells + +FIELD ;

s" FLOATING" environment? [IF] [IF]
: ffield:  ( offset <"name"> -- offset+1float )  \ 200x
\ Exec:    ( struc -- struc+offset )
  faligned 1 floats +FIELD ;

s" FLOATING-EXT" environment? [IF] [IF]
: sffield:  ( offset <"name"> -- offset+1sfloat )  \ 200x
\ Exec:     ( struc -- struc+offset )
  sfaligned 1 sfloats +FIELD ;

: dffield:  ( offset <"name"> -- offset+1dfloat )  \ 200x
\ Exec:     ( struc -- struc+offset )
  dfaligned 1 dfloats +FIELD ;
[THEN] [THEN]  \ FLOATING-EXT
[THEN] [THEN]  \ FLOATING


\ *** EXAMPLE

0 [IF] decimal

\ structure definition:
STRUCT ( point)
  1 cells +FIELD >x
          field: >y
  1 chars +FIELD >plotchar
        /STRUCT: /point

\ structure instance:
  create mypoint /point allot
    15 mypoint >x !
    22 mypoint >y !
    char o mypoint >plotchar c!

: show-mypoint  ( -- )
  mypoint cr ." mypoint structure instance:"
  cr ." x is " dup >x @ .
  cr ." y is " dup >y @ .
  cr ." the plot character is " >plotchar c@ emit  
  cr ." the structure size is " /point . ;

show-mypoint
[THEN]