Merge branch 'master' into build64

diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h
index a55d857..3c5a4cf 100644 (file)
--- a/csrc/pf_guts.h
+++ b/csrc/pf_guts.h
@@ -571,9 +571,12 @@ extern cell_t         gIncludeIndex;
 /* Force Quad alignment. */
 #define QUADUP(x) (((x)+3)&~3)
 
 /* Force Quad alignment. */
 #define QUADUP(x) (((x)+3)&~3)
 

+#ifndef MIN

 #define MIN(a,b)  ( ((a)<(b)) ? (a) : (b) )
 #define MIN(a,b)  ( ((a)<(b)) ? (a) : (b) )

+#endif
+#ifndef MAX

 #define MAX(a,b)  ( ((a)>(b)) ? (a) : (b) )
 #define MAX(a,b)  ( ((a)>(b)) ? (a) : (b) )

-
+#endif

 
 #ifndef TOUCH
     #define TOUCH(argument) ((void)argument)
 
 #ifndef TOUCH
     #define TOUCH(argument) ((void)argument)

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 57559bd..97fb004 100644 (file)
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -211,8 +211,8 @@ static int UdIsUint64( ucell_t Lo, ucell_t Hi )
         : Hi == 0);
 }
 
         : Hi == 0);
 }
 

-static const char *pfSelectFileModeCreate(cell_t fam );
-static const char *pfSelectFileModeOpen(cell_t fam );
+static const char *pfSelectFileModeCreate( cell_t fam );
+static const char *pfSelectFileModeOpen( cell_t fam );

 
 /**************************************************************/
 static const char *pfSelectFileModeCreate( cell_t fam )
 
 /**************************************************************/
 static const char *pfSelectFileModeCreate( cell_t fam )

diff --git a/csrc/pf_save.c b/csrc/pf_save.c
index f72981e..830eaee 100644 (file)
--- a/csrc/pf_save.c
+++ b/csrc/pf_save.c
@@ -315,7 +315,7 @@ cell_t ffSaveForth( const char *FileName, ExecToken EntryPoint, cell_t NameSize,
 /***************************************************************/
 static int Write32ToFile( FileStream *fid, uint32_t Val )
 {
 /***************************************************************/
 static int Write32ToFile( FileStream *fid, uint32_t Val )
 {

-    cell_t numw;
+    size_t numw;

     uint8_t pad[4];
 
     Write32BigEndian(pad,Val);
     uint8_t pad[4];
 
     Write32BigEndian(pad,Val);

diff --git a/fth/c_struct.fth b/fth/c_struct.fth
index 330ce38..bd06a50 100644 (file)
--- a/fth/c_struct.fth
+++ b/fth/c_struct.fth
@@ -94,13 +94,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 +110,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 +137,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 +152,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!"


@@ -213,21 +213,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

diff --git a/fth/member.fth b/fth/member.fth
index 3ff53d7..ceccc55 100644 (file)
--- a/fth/member.fth
+++ b/fth/member.fth
@@ -41,12 +41,18 @@ decimal
 ;
 
 \ Variables shared with object oriented code.
 ;
 
 \ Variables shared with object oriented code.

-    VARIABLE OB-STATE  ( Compilation state. )
-    VARIABLE OB-CURRENT-CLASS  ( ABS_CLASS_BASE of current class )
-    1 constant OB_DEF_CLASS   ( defining a class )
-    2 constant OB_DEF_STRUCT  ( defining a structure )
+VARIABLE OB-STATE  ( Compilation state. )
+VARIABLE OB-CURRENT-CLASS  ( ABS_CLASS_BASE of current class )
+1 constant OB_DEF_CLASS   ( defining a class )
+2 constant OB_DEF_STRUCT  ( defining a structure )

 
 

-4 constant OB_OFFSET_SIZE
+\ A member contains:
+\   cell size of data in bytes (1, 2, cell)
+\   cell offset within structure
+
+cell 1- constant CELL_MASK
+cell negate constant -CELL
+cell constant OB_OFFSET_SIZE

 
 : OB.OFFSET@ ( member_def -- offset ) @ ;
 : OB.OFFSET, ( value -- ) , ;
 
 : OB.OFFSET@ ( member_def -- offset ) @ ;
 : OB.OFFSET, ( value -- ) , ;


@@ -60,7 +66,7 @@ decimal
     ABS     ( -- |+-b| )
     ob-current-class @ ( -- b addr-space)
     tuck @          ( as #b c , current space needed )
     ABS     ( -- |+-b| )
     ob-current-class @ ( -- b addr-space)
     tuck @          ( as #b c , current space needed )

-    over 3 and 0=        ( multiple of four? )
+    over CELL_MASK and 0=        ( multiple of cell? )

     IF
         aligned
     ELSE
     IF
         aligned
     ELSE


@@ -147,7 +153,7 @@ decimal
 
 \ Aliases
 : APTR    ( <name> -- ) long ;
 
 \ Aliases
 : APTR    ( <name> -- ) long ;

-: RPTR    ( <name> -- ) -4 bytes ; \ relative relocatable pointer 00001
+: RPTR    ( <name> -- ) -cell bytes ; \ relative relocatable pointer 00001

 : ULONG   ( <name> -- ) long ;
 
 : STRUCT ( <struct> <new_ivar> -- , define a structure as an ivar )
 : ULONG   ( <name> -- ) long ;
 
 : STRUCT ( <struct> <new_ivar> -- , define a structure as an ivar )

diff --git a/fth/misc2.fth b/fth/misc2.fth
index c943e82..c0791da 100644 (file)
--- a/fth/misc2.fth
+++ b/fth/misc2.fth
@@ -122,18 +122,18 @@ variable rand-seed here rand-seed !
 : B->S ( c -- c' , sign extend byte )
     dup $ 80 and
     IF
 : B->S ( c -- c' , sign extend byte )
     dup $ 80 and
     IF

-        $ FFFFFF00 or
+        [ $ 0FF invert ] literal or

     ELSE
     ELSE

-        $ 000000FF and
+        $ 0FF and

     THEN
 ;
     THEN
 ;

-: W->S ( 16bit-signed -- 32bit-signed )
+: W->S ( 16bit-signed -- cell-signed )

     dup $ 8000 and
     dup $ 8000 and

-    if
-        $ FFFF0000 or
+    IF
+        [ $ 0FFFF invert ] literal or

     ELSE
     ELSE

-        $ 0000FFFF and
-    then
+        $ 0FFFF and
+    THEN

 ;
 
 : WITHIN { n1 n2 n3 -- flag }
 ;
 
 : WITHIN { n1 n2 n3 -- flag }

diff --git a/fth/system.fth b/fth/system.fth
index 21200fa..c84f08b 100644 (file)
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -836,4 +836,6 @@ decimal
 FREEZE    \ prevent forgetting below this point
 
 .( Dictionary compiled, save in "pforth.dic".) cr
 FREEZE    \ prevent forgetting below this point
 
 .( Dictionary compiled, save in "pforth.dic".) cr

+\ 300000 headers-size !
+\ 700000 code-size !

 c" pforth.dic" save-forth
 c" pforth.dic" save-forth