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.

diff --git a/csrc/pf_words.c b/csrc/pf_words.c
index 68f7862..8fe2fd3 100644 (file)
--- 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
 ***************************************************************/
 
 ** 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;
 {
     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 );
     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 );
     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; i<nc; i++ )
         {
     nc = n2-n3;
     if (nc > 0)
     {
         gScratch[0] = (char) nc;
         for( i=0; i<nc; i++ )
         {

-           gScratch[i+1] = s2[i];
+           gScratch[i+1] = Upcase ? pfCharToUpper( s2[i] ) : s2[i] ;

         }
     }
     else
         }
     }
     else


@@ -233,3 +236,15 @@ DBUGX(("ffWord: s3=%c, %d\n", *s3, n3 ));
     gCurrentTask->td_IN += (n1-n3) + 1;
     return &gScratch[0];
 }
     gCurrentTask->td_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 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -831,7 +831,7 @@ ThrowCode ffInterpret( void )
     {
 
         pfDebugMessage("ffInterpret: calling ffWord(()\n");
     {
 
         pfDebugMessage("ffInterpret: calling ffWord(()\n");

-        theWord = ffWord( BLANK );
+        theWord = ffLWord( BLANK );

         DBUG(("ffInterpret: theWord = 0x%x, Len = %d\n", theWord, *theWord ));
 
         if( *theWord > 0 )
         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 (file)
--- 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 );
 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 );
 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 (file)
--- a/fth/numberio.fth
+++ b/fth/numberio.fth
@@ -96,7 +96,7 @@ decimal
 
     base @ -rot                        ( base c-addr u )
 
 
     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
     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