From f75485364a6ebbc1a166a6687503c003bfa97313 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Wed, 21 Dec 2016 20:45:50 +0100 Subject: [PATCH] Use C version of LWORD in INTERPRET * csrc/pf_words.c (ffLWord): New. (Word): Factored out from ffWord. (ffWord): Call Word. * csrc/pfcompil.c (ffInterpret): Use ffLWord instead of ffWord to preserve case for NUMBER?. Can't use ffWord because that would convert a character written as "'a'" to "'A'". * csrc/pfcompil.h (ffLWord): Define prototype. * fth/numberio.fth: Fix typso. --- csrc/pf_words.c | 25 ++++++++++++++++++++----- csrc/pfcompil.c | 2 +- csrc/pfcompil.h | 1 + fth/numberio.fth | 2 +- 4 files changed, 23 insertions(+), 7 deletions(-) diff --git a/csrc/pf_words.c b/csrc/pf_words.c index 68f7862..8fe2fd3 100644 --- a/csrc/pf_words.c +++ b/csrc/pf_words.c @@ -203,8 +203,11 @@ cell_t ffNumberQ( const char *FWord, cell_t *Num ) ** Compiler Support ***************************************************************/ -/* ( char -- c-addr , parse word ) */ -char * ffWord( char c ) +/* Skip whitespace, then parse input delimited by C. If UPCASE is true + * convert the word to upper case. The result is stored in + * gScratch. + */ +static char * Word ( char c, int Upcase ) { char *s1,*s2,*s3; cell_t n1, n2, n3; @@ -213,16 +216,16 @@ char * ffWord( char c ) s1 = gCurrentTask->td_SourcePtr + gCurrentTask->td_IN; n1 = gCurrentTask->td_SourceNum - gCurrentTask->td_IN; n2 = ffSkip( s1, n1, c, &s2 ); -DBUGX(("ffWord: s2=%c, %d\n", *s2, n2 )); +DBUGX(("Word: s2=%c, %d\n", *s2, n2 )); n3 = ffScan( s2, n2, c, &s3 ); -DBUGX(("ffWord: s3=%c, %d\n", *s3, n3 )); +DBUGX(("Word: s3=%c, %d\n", *s3, n3 )); nc = n2-n3; if (nc > 0) { gScratch[0] = (char) nc; for( i=0; itd_IN += (n1-n3) + 1; return &gScratch[0]; } + +/* ( char -- c-addr , parse word ) */ +char * ffWord( char c ) +{ + return Word( c, TRUE ); +} + +/* ( char -- c-addr , parse word, preserving case ) */ +char * ffLWord( char c ) +{ + return Word( c, FALSE ); +} diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c index 04bc000..2f0c04e 100644 --- a/csrc/pfcompil.c +++ b/csrc/pfcompil.c @@ -831,7 +831,7 @@ ThrowCode ffInterpret( void ) { pfDebugMessage("ffInterpret: calling ffWord(()\n"); - theWord = ffWord( BLANK ); + theWord = ffLWord( BLANK ); DBUG(("ffInterpret: theWord = 0x%x, Len = %d\n", theWord, *theWord )); if( *theWord > 0 ) diff --git a/csrc/pfcompil.h b/csrc/pfcompil.h index 3ff831c..1323fa5 100644 --- a/csrc/pfcompil.h +++ b/csrc/pfcompil.h @@ -38,6 +38,7 @@ cell_t ffTokenToName( ExecToken XT, const ForthString **NFAPtr ); cell_t *NameToCode( ForthString *NFA ); PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize ); char *ffWord( char c ); +char *ffLWord( char c ); const ForthString *NameToPrevious( const ForthString *NFA ); cell_t FindSpecialCFAs( void ); cell_t FindSpecialXTs( void ); diff --git a/fth/numberio.fth b/fth/numberio.fth index 74d1006..e79c5b8 100644 --- a/fth/numberio.fth +++ b/fth/numberio.fth @@ -96,7 +96,7 @@ decimal base @ -rot ( base c-addr u ) - \ Regonize prefixes and change base if needed + \ Recognize prefixes and change base if needed over c@ >r ( base c-addr u ) ( r: char ) r@ [char] # = if rot drop 10 -rot 1 /string then r@ [char] $ = if rot drop 16 -rot 1 /string then -- 2.20.1