(       Title:  Quick and Dirty Structures
         File:  qdstruct.fs
      Version:  1.0.6
       Author:  David N. Williams
      License:  LGPL
Last Revision:  August 24, 2002
)
\ Copyright (C) 1999, 2001, 2002 by David N. Williams
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
MA 02111-1307 USA.

Please see the file POLITENESS included with this distribution.

ANS Forth compatible except for case sensitivity.

All "/" sizes are in bytes, and "struc" is the address of a
structure instance.
)

decimal


\ *** WORDS
(
  /MEMBER  /MEMBERS
  CHAR-MEMBERS  CELL-MEMBERS  2CELL-MEMBERS  NBYTE-MEMBERS
  CREATE-MEMBER  SAME-MEMBER  ALIGN-MEMBERS
  &MEMBER:  C@MEMBER:  C!MEMBER:   @MEMBER:  !MEMBER:
    2@MEMBER:  2!MEMBER:
  /STRUCT:

uncommentable:
  16BIT-MEMBERS
)


\ *** UNNAMED STRUCTURES

      0 value /members	\ running total offset
1 cells value /member	\ current member size


: char-members   ( -- )   1 chars to /member ;
: cell-members   ( -- )   1 cells to /member ;
: 2cell-members  ( -- )   2 cells to /member ;
: nbyte-members  ( n -- ) ( n) to /member ;

0 [IF]
: 16bit-members  ( -- )
  16 s" ADDRESS-UNIT-BITS" environment?
  0= ABORT" ADDRESS-UNIT-BITS undefined."
  / ( #chars)
  dup 0= ABORT" Address unit is more than 16 bits."
  chars to /member ;
[THEN]

: create-member  ( "name" -- )
  create /members dup , /member + to /members ;

: same-member  ( -- )  /members /member - to /members ;

: align-members  ( -- )  /members aligned to /members ;

: &member:  ( "name" -- )  create-member
DOES>  ( struc -- struc+offset )  @ ( offset) + ;

: c@member:  ( "name" -- ) create-member
DOES>  ( struc -- n ) @ ( offset) + c@ ;

: c!member:  ( "name" -- )  create-member
DOES>  ( n struc -- )  @ ( offset) + c! ;

: @member:  ( "name" -- )  create-member
DOES>  ( struc -- n )  @ ( offset) + @ ;

: 2@member:  ( "name" -- )  create-member
DOES>  ( struc -- n )  @ ( offset) + 2@ ;

: !member:  ( "name" -- )  create-member
DOES>  ( n struc -- )  @ ( offset) + ! ;

: 2!member:  ( "name" -- )  create-member
DOES>  ( n struc -- )  @ ( offset) + 2! ;

: /struct:  ( "name" -- )  create /members ,
DOES>  ( -- size )  @ ( offset) ;


\ *** EXAMPLE: ^Forth wordlist structure
0 [IF]
0 to /members
cell-members
&member:		>search-link
&member:		>voc-link
@member:		voc-name-ptr@
same-member !member:	voc-name-ptr!
16bit-members
&member:		>voc-res1
&member:		>voc-res2
&member:		>voc-flags
&member:		>voc-#chains
cell-members
@member:		voc-chain@
/struct:		/voc-struct
[THEN]