Long name support

csrc/pf_cglue.c

@@ -86,7 +86,7 @@ DBUG(("CallUserFunction: Index = %d, ReturnMode = %d, NumParams = %d\n",
 Err CreateGlueToC( const char *CName, ucell_t Index, cell_t ReturnMode, int32_t NumParams )
 {
     ucell_t Packed;
-    char FName[40];
+    char FName[LONGEST_WORD_NAME+9];    /* +1 for length, up to +9 should not be used, but is here for safety */
 
     CStringToForth( FName, CName, sizeof(FName) );
     Packed = (Index & 0xFFFF) | 0 | (NumParams << 24) |

csrc/pf_guts.h

@@ -26,8 +26,19 @@
 ** PFORTH_VERSION changes when PForth is modified.
 ** See README file for version info.
 */
-#define PFORTH_VERSION_CODE 32
-#define PFORTH_VERSION_NAME "2.1.0"
+#define PFORTH_VERSION_CODE 33
+#define PFORTH_VERSION_NAME "2.1.1"
+
+/* 
+ * NOTES about PF_SUPPORT_LONG_NAMES
+ * Most Forth word names are short - so 31 characters should be enough.
+ * However if you are integrating with other systems - for example libSDL
+ * some names are longer than 31 characters. This provides up to 63 characters 
+ * for word names.
+ *
+ * Long term this can become the default since there is no storage penalty
+ * when not using them.
+ */
 
 /*
 ** PFORTH_FILE_VERSION changes when incompatible changes are made
@@ -42,9 +53,16 @@
 ** FV9 - 20100503 - Added support for 64-bit CELL.
 ** FV10 - 20170103 - Added ID_FILE_FLUSH ID_FILE_RENAME ID_FILE_RESIZE
 ** FV11 - 20241226 - Added ID_SLEEP_P, ID_VAR_BYE_CODE, ID_VERSION_CODE
+** FV12 - 20241227 - Added Long name support, ID_FLAG_SMUDGE, ID_MASK_NAME_SIZE
 */
-#define PF_FILE_VERSION (11)   /* Bump this whenever primitives added. */
+
+#define PF_FILE_VERSION (12)   /* Bump this whenever primitives added. */
+
+#if defined(PF_SUPPORT_LONG_NAMES)
+#define PF_EARLIEST_FILE_VERSION (12)  /* earliest one still compatible */
+#else
 #define PF_EARLIEST_FILE_VERSION (9)  /* earliest one still compatible */
+#endif
 
 /***************************************************************
 ** Sizes and other constants
@@ -63,10 +81,20 @@
 #define FTRUE (-1)
 #define BLANK (' ')
 
-#define FLAG_PRECEDENCE (0x80)
+ /* The IMMEDIATE flag is known as the "precedence bit" on some other Forth systems. */
+ /* #define FLAG_PRECEDENCE (0x80) */
 #define FLAG_IMMEDIATE  (0x40)
+
+#ifdef PF_SUPPORT_LONG_NAMES
+#define FLAG_SMUDGE     (0x80)
+#define MASK_NAME_SIZE  (0x3F)
+#else
 #define FLAG_SMUDGE     (0x20)
 #define MASK_NAME_SIZE  (0x1F)
+#endif
+
+/* these the same, but have different names for clarity */
+#define LONGEST_WORD_NAME MASK_NAME_SIZE
 
 /* Debug TRACE flags */
 #define TRACE_INNER     (0x0002)
@@ -293,6 +321,8 @@ enum cforth_primitive_ids
     ID_SLEEP_P,        /* (SLEEP) V2.0.0 */
     ID_VAR_BYE_CODE,   /* BYE-CODE */
     ID_VERSION_CODE,
+    ID_FLAG_SMUDGE,
+    ID_MASK_NAME_SIZE,
 /* If you add a word above here,
 **   1. update PF_FILE_VERSION
 **   2. take away one reserved word below
@@ -301,8 +331,6 @@ enum cforth_primitive_ids
 /* Only reserve space if we are adding FP so that we can detect
 ** unsupported primitives when loading dictionary.
 */
-    ID_RESERVED03,
-    ID_RESERVED04,
     ID_RESERVED05,
     ID_RESERVED06,
     ID_RESERVED07,

csrc/pf_inner.c

@@ -1867,6 +1867,16 @@ DBUGX(("Before 0Branch: IP = 0x%x\n", InsPtr ));
 DBUGX(("After 0Branch: IP = 0x%x\n", InsPtr ));
             endcase;
 
+        case ID_FLAG_SMUDGE:
+            M_PUSH( TOS );
+            TOS = FLAG_SMUDGE;
+            endcase;
+
+        case ID_MASK_NAME_SIZE:
+            PUSH_TOS;
+            TOS = (cell_t) MASK_NAME_SIZE;
+            endcase;
+
         default:
             ERR("pfCatch: Unrecognised token = 0x");
             ffDotHex(Token);

csrc/pf_text.c

@@ -340,7 +340,7 @@ void TypeName( const char *Name )
     cell_t Len;
 
     FirstChar = Name+1;
-    Len = *Name & 0x1F;
+    Len = *Name & MASK_NAME_SIZE;
 
     ioType( FirstChar, Len );
 }

csrc/pfcompil.c

@@ -99,7 +99,7 @@ void CreateDicEntry( ExecToken XT, const ForthStringPtr FName, ucell_t Flags )
 */
 void CreateDicEntryC( ExecToken XT, const char *CName, ucell_t Flags )
 {
-    ForthString FName[40];
+    ForthString FName[LONGEST_WORD_NAME+9];    /* +1 for length, up to +9 should not be used, but is here for safety */
     CStringToForth( FName, CName, sizeof(FName) );
     CreateDicEntry( XT, FName, Flags );
 }
@@ -384,6 +384,8 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
     CreateDicEntryC( ID_WORD_STORE, "W!", 0 );
     CreateDicEntryC( ID_XOR, "XOR", 0 );
     CreateDicEntryC( ID_ZERO_BRANCH, "0BRANCH", 0 );
+    CreateDicEntryC( ID_FLAG_SMUDGE, "FLAG_SMUDGE", 0 );
+    CreateDicEntryC( ID_MASK_NAME_SIZE, "MASK_NAME_SIZE", 0 );
 
     pfDebugMessage("pfBuildDictionary: FindSpecialXTs\n");
     if( FindSpecialXTs() < 0 ) goto error;
@@ -460,7 +462,7 @@ cell_t ffFindNFA( const ForthString *WordName, const ForthString **NFAPtr )
     cell_t Searching = TRUE;
     cell_t Result = 0;
 
-    WordLen = (uint8_t) ((ucell_t)*WordName & 0x1F);
+    WordLen = (uint8_t) ((ucell_t)*WordName & MASK_NAME_SIZE);
     WordChar = WordName+1;
 
     NameField = (ForthString *) gVarContext;
@@ -653,7 +655,7 @@ void ffStringDefer( const ForthStringPtr FName, ExecToken DefaultXT )
 /* Convert name then create deferred dictionary entry. */
 static void CreateDeferredC( ExecToken DefaultXT, const char *CName )
 {
-    char FName[40];
+    char FName[LONGEST_WORD_NAME+9];    /* +1 for length, up to +9 should not be used, but is here for safety */
     CStringToForth( FName, CName, sizeof(FName) );
     ffStringDefer( FName, DefaultXT );
 }

fth/ansilocs.fth

@@ -32,7 +32,7 @@ private{
 
 decimal
 16 constant LV_MAX_VARS    \ maximum number of local variables
-31 constant LV_MAX_CHARS   \ maximum number of letters in name
+mask_name_size constant LV_MAX_CHARS   \ maximum number of letters in name
 
 lv_max_vars lv_max_chars $array LV-NAMES
 variable LV-#NAMES   \ number of names currently defined

fth/filefind.fth

@@ -56,7 +56,7 @@ ANEW TASK-FILEFIND.FTH
                 OF
                     dpth 0=
                     IF
-                        nfa count 31 and
+                        nfa count mask_name_size and
                         4 - swap 4 + swap
                         true -> stoploop
                     ELSE

fth/misc1.fth

@@ -100,8 +100,6 @@ variable TAB-WIDTH  8 TAB-WIDTH !
     tab-width @   swap - spaces
 ;
 
-$ 20 constant FLAG_SMUDGE
-
 \ Vocabulary listing
 : WORDS  ( -- )
     0 latest

fth/system.fth

@@ -102,7 +102,7 @@
 \ --------------------------------------------------------------------
 
 : ID.   ( nfa -- )
-    count 31 and type
+    count mask_name_size and type
 ;
 
 : DECIMAL   10 base !  ;
@@ -143,7 +143,7 @@
 \ Dictionary conversions ------------------------------------------
 
 : N>NEXTLINK  ( nfa -- nextlink , traverses name field )
-        dup c@ 31 and 1+ + aligned
+        dup c@ mask_name_size and 1+ + aligned
 ;
 
 : NAMEBASE  ( -- base-of-names )

fth/wordslik.fth

@@ -25,7 +25,7 @@ decimal
 
 
 : PARTIAL.MATCH.NAME  ( $str1 nfa  -- flag , is $str1 in nfa ??? )
-    count $ 1F and
+    count mask_name_size and
     rot count
     search
     >r 2drop r>