git.gag.com Git - debian/pforth/blob - fth/structure.fth

   1 \ Structures and fields.
   2 \
   3 \ The code is based on the implementation from the ANS standard.
   4 \
   5 \ Permission to use, copy, modify, and/or distribute this
   6 \ software for any purpose with or without fee is hereby granted.
   7 \
   8 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
   9 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  10 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  11 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  12 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  13 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  14 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16
  17 anew task-structure.fth
  18
  19 : BEGIN-STRUCTURE ( "<spaces>name" -- struct-sys 0 , start the definition of a structure )
  20     CREATE
  21         HERE 0 0 ,      \ mark stack, lay dummy
  22     DOES> @             \ -- structure-size
  23 ;
  24
  25 : END-STRUCTURE ( addr n -- , terminate a structure definition )
  26     SWAP !
  27 ;
  28
  29 : +FIELD  ( n <"name"> -- ; Exec: addr -- 'addr )
  30     CREATE OVER , +
  31     DOES> @ +
  32 ;
  33
  34 : FIELD:    ( n1 "name" -- n2 ; addr1 -- addr2 )
  35     ALIGNED 1 CELLS +FIELD
  36 ;
  37
  38 : CFIELD:   ( n1 "name" -- n2 ; addr1 -- addr2 )
  39     1 CHARS   +FIELD
  40 ;