Added field accessors.

common/structures.fs

@@ -17,18 +17,27 @@
 vocabulary structures   structures definitions
 
 variable last-align
-: typer ( sz "name" ) create dup , 1 max cell min ,
-                      does> dup cell+ @ last-align ! @ ;
-1 typer i8
-2 typer i16
-4 typer i32
-8 typer i64
-cell typer ptr
-long-size typer long
+variable last-typer
+: typer ( xt@ xt! sz "name" -- )
+   create dup , 1 max cell min , , ,
+   does> dup last-typer !  dup cell+ @ last-align !  @ ;
+: sc@ ( a -- c ) c@ dup 127 > if 256 - then ;
+' sc@ ' c! 1 typer i8
+' c@  ' c! 1 typer u8
+' sw@ ' w! 2 typer i16
+' uw@ ' w! 2 typer u16
+' sl@ ' l! 4 typer i32
+' ul@ ' l! 4 typer u32
+' @   ' !  8 typer i64  ( Wrong on 32-bit! )
+' @   ' !  cell typer ptr
+long-size cell = [IF]
+  : long   ptr ;
+[ELSE]
+  : long   i32 ;
+[THEN]
 
 variable last-struct
-
-: struct ( "name" ) 0 typer latestxt >body last-struct !
+: struct ( "name" ) 0 0 0 typer latestxt >body last-struct !
                     1 last-align ! ;
 : align-by ( a n -- a ) 1- dup >r + r> invert and ;
 : max! ( n a -- ) swap over @ max swap ! ;
@@ -37,7 +46,13 @@ variable last-struct
   last-struct @ @ swap align-by last-struct @ ! ;
 : field ( n "name" )
   last-align @ struct-align
-  create last-struct @ @ , last-struct @ +!
+  create last-struct @ @ ,   last-struct @ +!  last-typer @ ,
   does> @ + ;
 
+: field-op ( n "name" -- )
+  >r ' dup >body cell+ @ r> cells + @
+  state @ if >r , r> , else >r execute r> execute then ;
+: !field ( n "name" -- ) 2 field-op ; immediate
+: @field ( "name" -- n ) 3 field-op ; immediate
+
 forth definitions

common/structures_tests.fs

@@ -60,3 +60,48 @@ e: test-forth-structure
   0 t3 5 =assert
   0 t4 14 =assert
 ;e
+
+e: test-structure-accessors
+  also structures
+  struct foo
+    i8 field ->a
+    u8 field ->b
+    i16 field ->c
+    u16 field ->d
+    i32 field ->e
+    u32 field ->f
+    ptr field ->g
+  pad foo erase
+
+  127 pad !field ->a
+  255 pad !field ->b
+  32767 pad !field ->c
+  65535 pad !field ->d
+  2147483647 pad !field ->e
+  4294967295 pad !field ->f
+  1234 pad !field ->g
+
+  127 pad @field ->a =assert
+  255 pad @field ->b =assert
+  32767 pad @field ->c =assert
+  65535 pad @field ->d =assert
+  2147483647 pad @field ->e =assert
+  4294967295 pad @field ->f =assert
+  1234 pad @field ->g =assert
+
+  -128 pad !field ->a
+  0 pad !field ->b
+  -32768 pad !field ->c
+  0 pad !field ->d
+  -2147483648 pad !field ->e
+  0 pad !field ->f
+  1234 pad !field ->g
+
+  -128 pad @field ->a =assert
+  0 pad @field ->b =assert
+  -32768 pad @field ->c =assert
+  0 pad @field ->d =assert
+  -2147483648 pad @field ->e =assert
+  0 pad @field ->f =assert
+  1234 pad @field ->g =assert
+;e