From: Phil Burk Date: Sun, 19 May 2019 21:42:53 +0000 (-0700) Subject: pforth: improve 64-bit support X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/e14f25331be47e565ff6ae8cd7fb372fd329aff1 pforth: improve 64-bit support Use CELL instead of 4 in various places. Fix broken members in c_struct.fth --- diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h index 3667824..c0180c1 100644 --- a/csrc/pf_guts.h +++ b/csrc/pf_guts.h @@ -568,9 +568,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 8ecdec7..8a31b0e 100644 --- a/csrc/pf_inner.c +++ b/csrc/pf_inner.c @@ -199,11 +199,11 @@ static void TraceNames( ExecToken Token, cell_t Level ) /* Use local copy of CODE_BASE for speed. */ #define LOCAL_CODEREL_TO_ABS( a ) ((cell_t *) (((cell_t) a) + CodeBase)) -static const char *pfSelectFileModeCreate( int fam ); -static const char *pfSelectFileModeOpen( int fam ); +static const char *pfSelectFileModeCreate( cell_t fam ); +static const char *pfSelectFileModeOpen( cell_t fam ); /**************************************************************/ -static const char *pfSelectFileModeCreate( int fam ) +static const char *pfSelectFileModeCreate( cell_t fam ) { const char *famText = NULL; switch( fam ) @@ -228,7 +228,7 @@ static const char *pfSelectFileModeCreate( int fam ) } /**************************************************************/ -static const char *pfSelectFileModeOpen( int fam ) +static const char *pfSelectFileModeOpen( cell_t fam ) { const char *famText = NULL; switch( fam ) diff --git a/csrc/pf_save.c b/csrc/pf_save.c index 455b847..ac2c85e 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 ) { - int numw; + size_t numw; uint8_t pad[4]; Write32BigEndian(pad,Val); @@ -332,8 +332,8 @@ static cell_t WriteChunkToFile( FileStream *fid, cell_t ID, char *Data, int32_t EvenNumW = EVENUP(NumBytes); - if( Write32ToFile( fid, ID ) < 0 ) goto error; - if( Write32ToFile( fid, EvenNumW ) < 0 ) goto error; + if( Write32ToFile( fid, (uint32_t)ID ) < 0 ) goto error; + if( Write32ToFile( fid, (uint32_t)EvenNumW ) < 0 ) goto error; numw = sdWriteFile( Data, 1, EvenNumW, fid ); if( numw != EvenNumW ) goto error; diff --git a/csrc/pf_text.c b/csrc/pf_text.c index e48e457..03430a7 100644 --- a/csrc/pf_text.c +++ b/csrc/pf_text.c @@ -222,7 +222,7 @@ DBUGX(("ffCompareText: return 0x%x\n", Result )); ** Compare two strings, case sensitive. ** Return zero if they match, -1 if s1s2; */ -cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 ) +cell_t ffCompare( const char *s1, cell_t len1, const char *s2, cell_t len2 ) { cell_t i, result, n, diff; diff --git a/csrc/pf_text.h b/csrc/pf_text.h index 05431d7..9918fe3 100644 --- a/csrc/pf_text.h +++ b/csrc/pf_text.h @@ -54,8 +54,9 @@ void pfReportThrow( ThrowCode code ); char *ForthStringToC( char *dst, const char *FString, cell_t dstSize ); char *CStringToForth( char *dst, const char *CString, cell_t dstSize ); -cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 ); -cell_t ffCompareText( const char *s1, const char *s2, cell_t len ); +cell_t ffCompare(const char *s1, cell_t len1, + const char *s2, cell_t len2 ); +cell_t ffCompareText(const char *s1, const char *s2, cell_t len ); cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len ); void DumpMemory( void *addr, cell_t cnt); diff --git a/fth/c_struct.fth b/fth/c_struct.fth index 78cf163..46651ad 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 5aa84bd..7ff61c5 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 cf20173..09f585f 100644 --- a/fth/misc2.fth +++ b/fth/misc2.fth @@ -118,18 +118,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 b74c812..bed4334 100644 --- a/fth/system.fth +++ b/fth/system.fth @@ -821,4 +821,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