relicense to 0BSD

[pforth] / fth / c_struct.fth

diff --git a/fth/c_struct.fth b/fth/c_struct.fth
index 330ce38..14bf0d8 100644 (file)
--- a/fth/c_struct.fth
+++ b/fth/c_struct.fth
@@ -7,14 +7,17 @@
 \ Author: Phil Burk
 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
 \
 \ Author: Phil Burk
 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
 \

-\ The pForth software code is dedicated to the public domain,
-\ and any third party may reproduce, distribute and modify
-\ the pForth software code or any derivative works thereof
-\ without any compensation or license.  The pForth software
-\ code is provided on an "as is" basis without any warranty
-\ of any kind, including, without limitation, the implied
-\ warranties of merchantability and fitness for a particular
-\ purpose and their equivalents under the laws of any jurisdiction.
+\ Permission to use, copy, modify, and/or distribute this
+\ software for any purpose with or without fee is hereby granted.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
+\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

 \
 \ MOD: PLB 1/16/87 Use abort" instead of er.report
 \      MDH 4/14/87 Added sign-extend words to ..@
 \
 \ MOD: PLB 1/16/87 Use abort" instead of er.report
 \      MDH 4/14/87 Added sign-extend words to ..@


@@ -94,13 +97,13 @@ decimal
 : (S+REL!)  ( ptr addr offset -- )  + >r if.use->rel r> ! ;
 
 : compile+!bytes ( offset size -- )
 : (S+REL!)  ( ptr addr offset -- )  + >r if.use->rel r> ! ;
 
 : compile+!bytes ( offset size -- )

-\   ." compile+!bytes ( " over . dup . ." )" cr
+    \ ." compile+!bytes ( " over . dup . ." )" cr

     swap [compile] literal   \ compile offset into word
     CASE
     cell OF compile (s+!)  ENDOF
     2 OF compile (s+w!)      ENDOF
     1 OF compile (s+c!)      ENDOF
     swap [compile] literal   \ compile offset into word
     CASE
     cell OF compile (s+!)  ENDOF
     2 OF compile (s+w!)      ENDOF
     1 OF compile (s+c!)      ENDOF

-    -4 OF compile (s+rel!)   ENDOF \ 00002
+    -cell OF compile (s+rel!)   ENDOF \ 00002

     -2 OF compile (s+w!)     ENDOF
     -1 OF compile (s+c!)     ENDOF
     true abort" s! - illegal size!"
     -2 OF compile (s+w!)     ENDOF
     -1 OF compile (s+c!)     ENDOF
     true abort" s! - illegal size!"


@@ -110,7 +113,7 @@ decimal
 : !BYTES ( value address size -- )
     CASE
     cell OF ! ENDOF
 : !BYTES ( value address size -- )
     CASE
     cell OF ! ENDOF

-    -4 OF ( aptr addr )  swap if.use->rel swap ! ENDOF \ 00002
+    -cell OF ( aptr addr )  swap if.use->rel swap ! ENDOF \ 00002

     ABS
        2 OF w! ENDOF
        1 OF c! ENDOF
     ABS
        2 OF w! ENDOF
        1 OF c! ENDOF


@@ -137,7 +140,7 @@ decimal
     cell OF @  ENDOF
        2 OF w@      ENDOF
        1 OF c@      ENDOF
     cell OF @  ENDOF
        2 OF w@      ENDOF
        1 OF c@      ENDOF

-      -4 OF @ if.rel->use      ENDOF \ 00002
+      -cell OF @ if.rel->use      ENDOF \ 00002

       -2 OF w@ w->s     ENDOF
       -1 OF c@ b->s     ENDOF
        true abort" s@ - illegal size!"
       -2 OF w@ w->s     ENDOF
       -1 OF c@ b->s     ENDOF
        true abort" s@ - illegal size!"


@@ -152,13 +155,13 @@ decimal
 : (S+W@)  ( addr offset -- val )  + w@ w->s ;
 
 : compile+@bytes ( offset size -- )
 : (S+W@)  ( addr offset -- val )  + w@ w->s ;
 
 : compile+@bytes ( offset size -- )

-\   ." compile+@bytes ( " over . dup . ." )" cr
+    \ ." compile+@bytes ( " over . dup . ." )" cr

     swap [compile] literal   \ compile offset into word
     CASE
     cell OF compile (s+@)  ENDOF
     2 OF compile (s+uw@)      ENDOF
     1 OF compile (s+uc@)      ENDOF
     swap [compile] literal   \ compile offset into word
     CASE
     cell OF compile (s+@)  ENDOF
     2 OF compile (s+uw@)      ENDOF
     1 OF compile (s+uc@)      ENDOF

-    -4 OF compile (s+rel@)      ENDOF \ 00002
+    -cell OF compile (s+rel@)      ENDOF \ 00002

     -2 OF compile (s+w@)     ENDOF
     -1 OF compile (s+c@)     ENDOF
     true abort" s@ - illegal size!"
     -2 OF compile (s+w@)     ENDOF
     -1 OF compile (s+c@)     ENDOF
     true abort" s@ - illegal size!"


@@ -177,8 +180,6 @@ decimal
     (s@)
 ; immediate
 
     (s@)
 ; immediate
 

-
-

 exists? F* [IF]
 \ 951112 Floating Point support
 : FLPT  ( <name> -- , declare space for a floating point value. )
 exists? F* [IF]
 \ 951112 Floating Point support
 : FLPT  ( <name> -- , declare space for a floating point value. )


@@ -213,21 +214,28 @@ exists? F* [IF]
 :struct mapper
     long map_l1
     long map_l2
 :struct mapper
     long map_l1
     long map_l2

-    aptr map_a1
-    rptr map_r1
-    flpt map_f1

     short map_s1
     ushort map_s2
     byte map_b1
     ubyte map_b2
     short map_s1
     ushort map_s2
     byte map_b1
     ubyte map_b2

+    aptr map_a1
+    rptr map_r1
+    flpt map_f1

 ;struct
 mapper map1
 
 ;struct
 mapper map1
 

+." compiling TT" cr

 : TT
 : TT

+    123456 map1 s! map_l1
+    map1 s@ map_l1 123456 - abort" map_l1 failed!"
+    987654 map1 s! map_l2
+    map1 s@ map_l2 987654 - abort" map_l2 failed!"
+

     -500 map1 s! map_s1
     -500 map1 s! map_s1

-    map1 s@ map_s1 -500 - abort" map_s1 failed!"
+    map1 s@ map_s1 dup . cr -500 - abort" map_s1 failed!"

     -500 map1 s! map_s2
     map1 s@ map_s2 -500 $ FFFF and - abort" map_s2 failed!"
     -500 map1 s! map_s2
     map1 s@ map_s2 -500 $ FFFF and - abort" map_s2 failed!"

+

     -89 map1 s! map_b1
     map1 s@ map_b1 -89 - abort" map_s1 failed!"
     here map1 s! map_r1
     -89 map1 s! map_b1
     map1 s@ map_b1 -89 - abort" map_s1 failed!"
     here map1 s! map_r1