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 ;
|
