[Win32forth-cvs] win32forth-stc/src Struct200x.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7930

Added Files:
	Struct200x.f 
Log Message:
Jos: Renamed the file with the duplicate name and redefined +field as George Hubert hinted.

--- NEW FILE: Struct200x.f ---
\ $Id: Struct200x.f,v 1.1 2007/06/02 11:40:16 jos_ven Exp $ \

\ --------------------------- Change Block -------------------------------
\
\
\ ------------------------- End Change Block -----------------------------
\
\ Experimental: a fully optimising, STC based, ANS Forth compliant kernel
\
\ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
\
\ This program is free software; you can redistribute it and/or modify it
\ under the terms of the GNU General Public License as published by the
\ Free Software Foundation; either version 2 of the License, or <at your
\ option> any later version.
\
\ This program 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
\ General Public License for more details.
\
\ You should have received a copy of the GNU General Public License along
\ with this program; if not, write to the Free Software Foundation, Inc.,
\ 675 Mass Ave, Cambridge, MA 02139, USA.
\
\ ------------------------------------------------------------------------

\ RfD: Structures - Version 4
\ 6 February 2007, Stephen Pelc

\ ------------------------------------------------------------------------

: begin-structure     ( -- addr 0 )
             create here 0 0 ,
             does> ( -- size ) @ ;

: end-structure       ( addr n -- )
             swap ! ;                \ set size

(( : +field     ( n1 n2 "name" -- n3 ) \ ANSI version
             create over , +
             does> ( addr -- addr+n1 ) @ + ; ))

' field+ alias +field  \ Uses the ST optimizer

: field:     ( n1 <"name"> -- n2 ) ( addr -- 'addr )  aligned cell +FIELD ;
: cfield:    ( n1 <"name"> -- n2 ) ( addr -- 'addr )  1 chars +FIELD ;
: bfield:    ( n1 <"name"> -- n2 ) ( addr -- 'addr )  1 +FIELD ;
: wfield:    ( n1 <"name"> -- n2 ) ( addr -- 'addr )  2 +FIELD ;
: lfield:    ( n1 <"name"> -- n2 ) ( addr -- 'addr )  4 +FIELD ;
: xfield:    ( n1 <"name"> -- n2 ) ( addr -- 'addr )  8 +FIELD ;