From: Phil Burk Date: Sun, 19 May 2019 21:55:10 +0000 (-0700) Subject: Merge branch 'master' into build64 X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/c1a87b8298475c3fdd007b14a1413d2a6fd0fa61?hp=ee8dc9e9e0f59b8e38dec3732caefe9f3af2b431 Merge branch 'master' into build64 --- diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h index a55d857..3c5a4cf 100644 --- 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) +#ifndef MIN #define MIN(a,b) ( ((a)<(b)) ? (a) : (b) ) +#endif +#ifndef MAX #define MAX(a,b) ( ((a)>(b)) ? (a) : (b) ) - +#endif #ifndef TOUCH #define TOUCH(argument) ((void)argument) diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c index 57559bd..97fb004 100644 --- 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); } -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 ) diff --git a/csrc/pf_save.c b/csrc/pf_save.c index f72981e..830eaee 100644 --- 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 ) { - cell_t numw; + size_t numw; uint8_t pad[4]; Write32BigEndian(pad,Val); diff --git a/fth/c_struct.fth b/fth/c_struct.fth index 330ce38..bd06a50 100644 --- 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 -- ) -\ ." 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 - -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!" @@ -110,7 +110,7 @@ decimal : !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 @@ -137,7 +137,7 @@ decimal 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!" @@ -152,13 +152,13 @@ decimal : (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 - -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!" @@ -213,21 +213,28 @@ exists? F* [IF] :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 + aptr map_a1 + rptr map_r1 + flpt map_f1 ;struct mapper map1 +." compiling TT" cr : 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 - 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!" + -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 --- a/fth/member.fth +++ b/fth/member.fth @@ -41,12 +41,18 @@ decimal ; \ 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 -- ) , ; @@ -60,7 +66,7 @@ decimal 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 @@ -147,7 +153,7 @@ decimal \ Aliases : APTR ( -- ) long ; -: RPTR ( -- ) -4 bytes ; \ relative relocatable pointer 00001 +: RPTR ( -- ) -cell bytes ; \ relative relocatable pointer 00001 : ULONG ( -- ) long ; : STRUCT ( -- , define a structure as an ivar ) diff --git a/fth/misc2.fth b/fth/misc2.fth index c943e82..c0791da 100644 --- 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 - $ FFFFFF00 or + [ $ 0FF invert ] literal or ELSE - $ 000000FF and + $ 0FF and THEN ; -: W->S ( 16bit-signed -- 32bit-signed ) +: W->S ( 16bit-signed -- cell-signed ) dup $ 8000 and - if - $ FFFF0000 or + IF + [ $ 0FFFF invert ] literal or ELSE - $ 0000FFFF and - then + $ 0FFFF and + THEN ; : WITHIN { n1 n2 n3 -- flag } diff --git a/fth/system.fth b/fth/system.fth index 21200fa..c84f08b 100644 --- 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 +\ 300000 headers-size ! +\ 700000 code-size ! c" pforth.dic" save-forth