X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/a1f4e52df60d8f26327ed57f5a9e7b70d0a04273..8e9db35f299d8f606ba003d3cd8fa9e2c868c880:/csrc/pf_text.c

diff --git a/csrc/pf_text.c b/csrc/pf_text.c
index 9325851..e48e457 100644
--- a/csrc/pf_text.c
+++ b/csrc/pf_text.c
@@ -1,407 +1,407 @@
-/* @(#) pf_text.c 98/01/26 1.3 */
-/***************************************************************
-** Text Strings for Error Messages
-** Various Text tools.
-**
-** For PForth based on 'C'
-**
-** Author: Phil Burk
-** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
-**
-** The pForth software code is dedicated to the public domain,
-** and any third party may reproduce, distribute and modify
-** the pForth software code or any derivative works thereof
-** without any compensation or license.  The pForth software
-** code is provided on an "as is" basis without any warranty
-** of any kind, including, without limitation, the implied
-** warranties of merchantability and fitness for a particular
-** purpose and their equivalents under the laws of any jurisdiction.
-**
-****************************************************************
-** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers.
-** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash.
-***************************************************************/
-
-#include "pf_all.h"
-
-#define PF_ENGLISH
-
-/*
-** Define array of error messages.
-** These are defined in one place to make it easier to translate them.
-*/
-#ifdef PF_ENGLISH
-/***************************************************************/
-void pfReportError( const char *FunctionName, Err ErrCode )
-{
-	const char *s;
-	
-	MSG("Error in ");
-	MSG(FunctionName);
-	MSG(" - ");
-	
-	switch(ErrCode & 0xFF)
-	{
-	case PF_ERR_NO_MEM & 0xFF:
-		s = "insufficient memory"; break;
-	case PF_ERR_TOO_BIG & 0xFF:
-		s = "data chunk too large"; break;
-	case PF_ERR_NUM_PARAMS & 0xFF:
-		s = "incorrect number of parameters"; break;
-	case PF_ERR_OPEN_FILE & 0xFF:
-		s = "could not open file"; break;
-	case PF_ERR_WRONG_FILE & 0xFF:
-		s = "wrong type of file format"; break;
-	case PF_ERR_BAD_FILE & 0xFF:
-		s = "badly formatted file"; break;
-	case PF_ERR_READ_FILE & 0xFF:
-		s = "file read failed"; break;
-	case PF_ERR_WRITE_FILE & 0xFF:
-		s = "file write failed"; break;
-	case PF_ERR_CORRUPT_DIC & 0xFF:
-		s = "corrupted dictionary"; break;
-	case PF_ERR_NOT_SUPPORTED & 0xFF:
-		s = "not supported in this version"; break;
-	case PF_ERR_VERSION_FUTURE & 0xFF:
-		s = "version from future"; break;
-	case PF_ERR_VERSION_PAST & 0xFF:
-		s = "version is obsolete. Rebuild new one."; break;
-	case PF_ERR_COLON_STACK & 0xFF:
-		s = "stack depth changed between : and ; . Probably unbalanced conditional"; break;
-	case PF_ERR_HEADER_ROOM & 0xFF:
-		s = "no room left in header space"; break;
-	case PF_ERR_CODE_ROOM & 0xFF:
-		s = "no room left in code space"; break;
-	case PF_ERR_NO_SHELL & 0xFF:
-		s = "attempt to use names in forth compiled with PF_NO_SHELL"; break;
-	case PF_ERR_NO_NAMES & 0xFF:
-		s = "dictionary has no names";  break;
-	case PF_ERR_OUT_OF_RANGE & 0xFF:
-		s = "parameter out of range";  break;
-	case PF_ERR_ENDIAN_CONFLICT & 0xFF:
-		s = "endian-ness of dictionary does not match code";  break;
-	case PF_ERR_FLOAT_CONFLICT & 0xFF:
-		s = "float support mismatch between .dic file and code";  break;
-	case PF_ERR_CELL_SIZE_CONFLICT & 0xFF:
-		s = "cell size mismatch between .dic file and code";  break;
-	default:
-		s = "unrecognized error code!"; break;
-	}
-	MSG(s);
-	EMIT_CR;
-}
-
-void pfReportThrow( ThrowCode code )
-{
-	const char *s = NULL;
-	switch(code)
-	{
-	case THROW_ABORT:
-	case THROW_ABORT_QUOTE:
-		s = "ABORT"; break;
-	case THROW_STACK_OVERFLOW:
-		s = "Stack overflow!"; break;
-	case THROW_STACK_UNDERFLOW:
-		s = "Stack underflow!"; break;
-	case THROW_EXECUTING:
-		s = "Executing a compile-only word!"; break;
-	case THROW_FLOAT_STACK_UNDERFLOW:
-		s = "Float Stack underflow!"; break;
-	case THROW_UNDEFINED_WORD:
-		s = "Undefined word!"; break;
-	case THROW_PAIRS:
-		s = "Conditional control structure mismatch!"; break;
-	case THROW_BYE:
-	case THROW_QUIT:
-		break;
-	case THROW_SEMICOLON:
-		s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;
-	case THROW_DEFERRED:
-		s = "Not a DEFERred word!"; break;
-	default:
-		s = "Unrecognized throw code!"; break;
-	}
-	
-	if( s )
-	{
-		MSG_NUM_D("THROW code = ", code );
-		MSG(s);
-		EMIT_CR;
-	}
-}
-#endif
-
-/**************************************************************
-** Copy a Forth String to a 'C' string.
-*/
-
-char *ForthStringToC( char *dst, const char *FString, cell_t dstSize )
-{
-	cell_t Len;
-
-	Len = (cell_t) *FString;
-	/* Make sure the text + NUL can fit. */
-	if( Len >= dstSize )
-	{
-		Len = dstSize - 1;
-	}
-	pfCopyMemory( dst, FString+1, Len );
-	dst[Len] = '\0';
-
-	return dst;
-}
-
-/**************************************************************
-** Copy a NUL terminated string to a Forth counted string.
-*/
-char *CStringToForth( char *dst, const char *CString, cell_t dstSize )
-{
-	cell_t i;
-
-	/* Make sure the SIZE+text can fit. */
-	for( i=1; i<dstSize; i++ )
-	{
-		if( *CString == 0 )
-		{
-			break;
-		}
-		dst[i] = *CString++;
-	}
-	*dst = (char ) i-1;
-	return dst;
-}
-
-/**************************************************************
-** Compare two test strings, case sensitive.
-** Return TRUE if they match.
-*/
-cell_t ffCompareText( const char *s1, const char *s2, cell_t len )
-{
-	cell_t i, Result;
-	
-	Result = TRUE;
-	for( i=0; i<len; i++ )
-	{
-DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));
-		if( *s1++ != *s2++ )
-		{
-			Result = FALSE;
-			break;
-		}
-	}
-DBUGX(("ffCompareText: return 0x%x\n", Result ));
-	return Result;
-}
-
-/**************************************************************
-** Compare two test strings, case INsensitive.
-** Return TRUE if they match.
-*/
-cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )
-{
-	cell_t i, Result;
-	char  c1,c2;
-	
-	Result = TRUE;
-	for( i=0; i<len; i++ )
-	{
-		c1 = pfCharToLower(*s1++);
-		c2 = pfCharToLower(*s2++);
-DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));
-		if( c1 != c2 )
-		{
-			Result = FALSE;
-			break;
-		}
-	}
-DBUGX(("ffCompareText: return 0x%x\n", Result ));
-	return Result;
-}
-
-/**************************************************************
-** Compare two strings, case sensitive.
-** Return zero if they match, -1 if s1<s2, +1 is s1>s2;
-*/
-cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 )
-{
-	cell_t i, result, n, diff;
-	
-	result = 0;
-	n = MIN(len1,len2);
-	for( i=0; i<n; i++ )
-	{
-		if( (diff = (*s2++ - *s1++)) != 0 )
-		{
-			result = (diff > 0) ? -1 : 1 ;
-			break;
-		}
-	}
-	if( result == 0 )  /* Match up to MIN(len1,len2) */
-	{
-		if( len1 < len2 )
-		{
-			result = -1;
-		}
-		else if ( len1 > len2 )
-		{
-			result = 1;
-		}
-	}
-	return result;
-}
-
-/***************************************************************
-** Convert number to text.
-*/
-#define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2)  /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */
-static char cnttPad[CNTT_PAD_SIZE];
-
-char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )
-{
-	cell_t IfNegative = 0;
-	char *p,c;
-	ucell_t NewNum, Rem, uNum;
-	cell_t i = 0;
-	
-	uNum = Num;
-	if( IfSigned )
-	{
-/* Convert to positive and keep sign. */
-		if( Num < 0 )
-		{
-			IfNegative = TRUE;
-			uNum = -Num;
-		}
-	}
-	
-/* Point past end of Pad */
-	p = cnttPad + CNTT_PAD_SIZE;
-	*(--p) = (char) 0; /* NUL terminate */
-	
-	while( (i++<MinChars) || (uNum != 0) )
-	{
-		NewNum = uNum / Base;
-		Rem = uNum - (NewNum * Base);
-		c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));
-		*(--p) = c;
-		uNum = NewNum;
-	}
-	
-	if( IfSigned )
-	{
-		if( IfNegative ) *(--p) = '-';
-	}
-	return p;
-}
-
-/***************************************************************
-** Diagnostic routine that prints memory in table format.
-*/
-void DumpMemory( void *addr, cell_t cnt)
-{
-	cell_t ln, cn, nlines;
-	unsigned char *ptr, *cptr, c;
-
-	nlines = (cnt + 15) / 16;
-
-	ptr = (unsigned char *) addr;
-
-	EMIT_CR;
-	
-	for (ln=0; ln<nlines; ln++)
-	{
-		MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );
-		MSG(": ");
-		cptr = ptr;
-		for (cn=0; cn<16; cn++)
-		{
-			MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );
-			EMIT(' ');
-		}
-		EMIT(' ');
-		for (cn=0; cn<16; cn++)
-		{
-			c = *ptr++;
-			if ((c < ' ') || (c > '}')) c = '.';
-			EMIT(c);
-		}
-		EMIT_CR;
-	}
-}
-
-
-/* Print name, mask off any dictionary bits. */
-void TypeName( const char *Name )
-{
-	const char *FirstChar;
-	cell_t Len;
-	
-	FirstChar = Name+1;
-	Len = *Name & 0x1F;
-	
-	ioType( FirstChar, Len );
-}
-
-
-
-#ifdef PF_UNIT_TEST
-/* Unit test for string conversion routines. */
-#define ASSERT_PAD_IS( index, value, msg ) \
-	if( pad[index] != ((char)(value)) ) \
-	{ \
-		ERR(( "ERROR text test failed: " msg "\n")); \
-		numErrors += 1; \
-	} \
-
-cell_t pfUnitTestText( void )
-{
-	cell_t numErrors = 0;
-	char pad[16];
-	char fpad[8];
-
-	/* test CStringToForth */
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	CStringToForth( pad, "frog", 6 );
-	ASSERT_PAD_IS( 0, 4, "CS len 6" );
-	ASSERT_PAD_IS( 4, 'g', "CS end 6" );
-	ASSERT_PAD_IS( 5, 0xA5, "CS past 6" );
-	
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	CStringToForth( pad, "frog", 5 );
-	ASSERT_PAD_IS( 0, 4, "CS len 5" );
-	ASSERT_PAD_IS( 4, 'g', "CS end 5" );
-	ASSERT_PAD_IS( 5, 0xA5, "CS past 5" );
-	
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	CStringToForth( pad, "frog", 4 );
-	ASSERT_PAD_IS( 0, 3, "CS len 4" );
-	ASSERT_PAD_IS( 3, 'o', "CS end 4" );
-	ASSERT_PAD_IS( 4, 0xA5, "CS past 4" );
-	
-	/* Make a Forth string for testing ForthStringToC. */
-	CStringToForth( fpad, "frog", sizeof(fpad) );
-	
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	ForthStringToC( pad, fpad, 6 );
-	ASSERT_PAD_IS( 0, 'f', "FS len 6" );
-	ASSERT_PAD_IS( 3, 'g', "FS end 6" );
-	ASSERT_PAD_IS( 4, 0, "FS nul 6" );
-	ASSERT_PAD_IS( 5, 0xA5, "FS past 6" );
-	
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	ForthStringToC( pad, fpad, 5 );
-	ASSERT_PAD_IS( 0, 'f', "FS len 5" );
-	ASSERT_PAD_IS( 3, 'g', "FS end 5" );
-	ASSERT_PAD_IS( 4, 0, "FS nul 5" );
-	ASSERT_PAD_IS( 5, 0xA5, "FS past 5" );
-	
-	pfSetMemory(pad,0xA5,sizeof(pad));
-	ForthStringToC( pad, fpad, 4 );
-	ASSERT_PAD_IS( 0, 'f', "FS len 4" );
-	ASSERT_PAD_IS( 2, 'o', "FS end 4" );
-	ASSERT_PAD_IS( 3, 0, "FS nul 4" );
-	ASSERT_PAD_IS( 4, 0xA5, "FS past 4" );
-	
-	return numErrors;
-}
-#endif
+/* @(#) pf_text.c 98/01/26 1.3 */
+/***************************************************************
+** Text Strings for Error Messages
+** Various Text tools.
+**
+** For PForth based on 'C'
+**
+** Author: Phil Burk
+** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
+**
+** The pForth software code is dedicated to the public domain,
+** and any third party may reproduce, distribute and modify
+** the pForth software code or any derivative works thereof
+** without any compensation or license.  The pForth software
+** code is provided on an "as is" basis without any warranty
+** of any kind, including, without limitation, the implied
+** warranties of merchantability and fitness for a particular
+** purpose and their equivalents under the laws of any jurisdiction.
+**
+****************************************************************
+** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers.
+** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash.
+***************************************************************/
+
+#include "pf_all.h"
+
+#define PF_ENGLISH
+
+/*
+** Define array of error messages.
+** These are defined in one place to make it easier to translate them.
+*/
+#ifdef PF_ENGLISH
+/***************************************************************/
+void pfReportError( const char *FunctionName, Err ErrCode )
+{
+    const char *s;
+
+    MSG("Error in ");
+    MSG(FunctionName);
+    MSG(" - ");
+
+    switch(ErrCode & 0xFF)
+    {
+    case PF_ERR_NO_MEM & 0xFF:
+        s = "insufficient memory"; break;
+    case PF_ERR_TOO_BIG & 0xFF:
+        s = "data chunk too large"; break;
+    case PF_ERR_NUM_PARAMS & 0xFF:
+        s = "incorrect number of parameters"; break;
+    case PF_ERR_OPEN_FILE & 0xFF:
+        s = "could not open file"; break;
+    case PF_ERR_WRONG_FILE & 0xFF:
+        s = "wrong type of file format"; break;
+    case PF_ERR_BAD_FILE & 0xFF:
+        s = "badly formatted file"; break;
+    case PF_ERR_READ_FILE & 0xFF:
+        s = "file read failed"; break;
+    case PF_ERR_WRITE_FILE & 0xFF:
+        s = "file write failed"; break;
+    case PF_ERR_CORRUPT_DIC & 0xFF:
+        s = "corrupted dictionary"; break;
+    case PF_ERR_NOT_SUPPORTED & 0xFF:
+        s = "not supported in this version"; break;
+    case PF_ERR_VERSION_FUTURE & 0xFF:
+        s = "version from future"; break;
+    case PF_ERR_VERSION_PAST & 0xFF:
+        s = "version is obsolete. Rebuild new one."; break;
+    case PF_ERR_COLON_STACK & 0xFF:
+        s = "stack depth changed between : and ; . Probably unbalanced conditional"; break;
+    case PF_ERR_HEADER_ROOM & 0xFF:
+        s = "no room left in header space"; break;
+    case PF_ERR_CODE_ROOM & 0xFF:
+        s = "no room left in code space"; break;
+    case PF_ERR_NO_SHELL & 0xFF:
+        s = "attempt to use names in forth compiled with PF_NO_SHELL"; break;
+    case PF_ERR_NO_NAMES & 0xFF:
+        s = "dictionary has no names";  break;
+    case PF_ERR_OUT_OF_RANGE & 0xFF:
+        s = "parameter out of range";  break;
+    case PF_ERR_ENDIAN_CONFLICT & 0xFF:
+        s = "endian-ness of dictionary does not match code";  break;
+    case PF_ERR_FLOAT_CONFLICT & 0xFF:
+        s = "float support mismatch between .dic file and code";  break;
+    case PF_ERR_CELL_SIZE_CONFLICT & 0xFF:
+        s = "cell size mismatch between .dic file and code";  break;
+    default:
+        s = "unrecognized error code!"; break;
+    }
+    MSG(s);
+    EMIT_CR;
+}
+
+void pfReportThrow( ThrowCode code )
+{
+    const char *s = NULL;
+    switch(code)
+    {
+    case THROW_ABORT:
+    case THROW_ABORT_QUOTE:
+        s = "ABORT"; break;
+    case THROW_STACK_OVERFLOW:
+        s = "Stack overflow!"; break;
+    case THROW_STACK_UNDERFLOW:
+        s = "Stack underflow!"; break;
+    case THROW_EXECUTING:
+        s = "Executing a compile-only word!"; break;
+    case THROW_FLOAT_STACK_UNDERFLOW:
+        s = "Float Stack underflow!"; break;
+    case THROW_UNDEFINED_WORD:
+        s = "Undefined word!"; break;
+    case THROW_PAIRS:
+        s = "Conditional control structure mismatch!"; break;
+    case THROW_BYE:
+    case THROW_QUIT:
+        break;
+    case THROW_SEMICOLON:
+        s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;
+    case THROW_DEFERRED:
+        s = "Not a DEFERred word!"; break;
+    default:
+        s = "Unrecognized throw code!"; break;
+    }
+
+    if( s )
+    {
+        MSG_NUM_D("THROW code = ", code );
+        MSG(s);
+        EMIT_CR;
+    }
+}
+#endif
+
+/**************************************************************
+** Copy a Forth String to a 'C' string.
+*/
+
+char *ForthStringToC( char *dst, const char *FString, cell_t dstSize )
+{
+    cell_t Len;
+
+    Len = (cell_t) *FString;
+    /* Make sure the text + NUL can fit. */
+    if( Len >= dstSize )
+    {
+        Len = dstSize - 1;
+    }
+    pfCopyMemory( dst, FString+1, Len );
+    dst[Len] = '\0';
+
+    return dst;
+}
+
+/**************************************************************
+** Copy a NUL terminated string to a Forth counted string.
+*/
+char *CStringToForth( char *dst, const char *CString, cell_t dstSize )
+{
+    cell_t i;
+
+    /* Make sure the SIZE+text can fit. */
+    for( i=1; i<dstSize; i++ )
+    {
+        if( *CString == 0 )
+        {
+            break;
+        }
+        dst[i] = *CString++;
+    }
+    *dst = (char ) i-1;
+    return dst;
+}
+
+/**************************************************************
+** Compare two test strings, case sensitive.
+** Return TRUE if they match.
+*/
+cell_t ffCompareText( const char *s1, const char *s2, cell_t len )
+{
+    cell_t i, Result;
+
+    Result = TRUE;
+    for( i=0; i<len; i++ )
+    {
+DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));
+        if( *s1++ != *s2++ )
+        {
+            Result = FALSE;
+            break;
+        }
+    }
+DBUGX(("ffCompareText: return 0x%x\n", Result ));
+    return Result;
+}
+
+/**************************************************************
+** Compare two test strings, case INsensitive.
+** Return TRUE if they match.
+*/
+cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )
+{
+    cell_t i, Result;
+    char  c1,c2;
+
+    Result = TRUE;
+    for( i=0; i<len; i++ )
+    {
+        c1 = pfCharToLower(*s1++);
+        c2 = pfCharToLower(*s2++);
+DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));
+        if( c1 != c2 )
+        {
+            Result = FALSE;
+            break;
+        }
+    }
+DBUGX(("ffCompareText: return 0x%x\n", Result ));
+    return Result;
+}
+
+/**************************************************************
+** Compare two strings, case sensitive.
+** Return zero if they match, -1 if s1<s2, +1 is s1>s2;
+*/
+cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 )
+{
+    cell_t i, result, n, diff;
+
+    result = 0;
+    n = MIN(len1,len2);
+    for( i=0; i<n; i++ )
+    {
+        if( (diff = (*s2++ - *s1++)) != 0 )
+        {
+            result = (diff > 0) ? -1 : 1 ;
+            break;
+        }
+    }
+    if( result == 0 )  /* Match up to MIN(len1,len2) */
+    {
+        if( len1 < len2 )
+        {
+            result = -1;
+        }
+        else if ( len1 > len2 )
+        {
+            result = 1;
+        }
+    }
+    return result;
+}
+
+/***************************************************************
+** Convert number to text.
+*/
+#define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2)  /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */
+static char cnttPad[CNTT_PAD_SIZE];
+
+char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )
+{
+    cell_t IfNegative = 0;
+    char *p,c;
+    ucell_t NewNum, Rem, uNum;
+    cell_t i = 0;
+
+    uNum = Num;
+    if( IfSigned )
+    {
+/* Convert to positive and keep sign. */
+        if( Num < 0 )
+        {
+            IfNegative = TRUE;
+            uNum = -Num;
+        }
+    }
+
+/* Point past end of Pad */
+    p = cnttPad + CNTT_PAD_SIZE;
+    *(--p) = (char) 0; /* NUL terminate */
+
+    while( (i++<MinChars) || (uNum != 0) )
+    {
+        NewNum = uNum / Base;
+        Rem = uNum - (NewNum * Base);
+        c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));
+        *(--p) = c;
+        uNum = NewNum;
+    }
+
+    if( IfSigned )
+    {
+        if( IfNegative ) *(--p) = '-';
+    }
+    return p;
+}
+
+/***************************************************************
+** Diagnostic routine that prints memory in table format.
+*/
+void DumpMemory( void *addr, cell_t cnt)
+{
+    cell_t ln, cn, nlines;
+    unsigned char *ptr, *cptr, c;
+
+    nlines = (cnt + 15) / 16;
+
+    ptr = (unsigned char *) addr;
+
+    EMIT_CR;
+
+    for (ln=0; ln<nlines; ln++)
+    {
+        MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );
+        MSG(": ");
+        cptr = ptr;
+        for (cn=0; cn<16; cn++)
+        {
+            MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );
+            EMIT(' ');
+        }
+        EMIT(' ');
+        for (cn=0; cn<16; cn++)
+        {
+            c = *ptr++;
+            if ((c < ' ') || (c > '}')) c = '.';
+            EMIT(c);
+        }
+        EMIT_CR;
+    }
+}
+
+
+/* Print name, mask off any dictionary bits. */
+void TypeName( const char *Name )
+{
+    const char *FirstChar;
+    cell_t Len;
+
+    FirstChar = Name+1;
+    Len = *Name & 0x1F;
+
+    ioType( FirstChar, Len );
+}
+
+
+
+#ifdef PF_UNIT_TEST
+/* Unit test for string conversion routines. */
+#define ASSERT_PAD_IS( index, value, msg ) \
+    if( pad[index] != ((char)(value)) ) \
+    { \
+        ERR(( "ERROR text test failed: " msg "\n")); \
+        numErrors += 1; \
+    } \
+
+cell_t pfUnitTestText( void )
+{
+    cell_t numErrors = 0;
+    char pad[16];
+    char fpad[8];
+
+    /* test CStringToForth */
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    CStringToForth( pad, "frog", 6 );
+    ASSERT_PAD_IS( 0, 4, "CS len 6" );
+    ASSERT_PAD_IS( 4, 'g', "CS end 6" );
+    ASSERT_PAD_IS( 5, 0xA5, "CS past 6" );
+
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    CStringToForth( pad, "frog", 5 );
+    ASSERT_PAD_IS( 0, 4, "CS len 5" );
+    ASSERT_PAD_IS( 4, 'g', "CS end 5" );
+    ASSERT_PAD_IS( 5, 0xA5, "CS past 5" );
+
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    CStringToForth( pad, "frog", 4 );
+    ASSERT_PAD_IS( 0, 3, "CS len 4" );
+    ASSERT_PAD_IS( 3, 'o', "CS end 4" );
+    ASSERT_PAD_IS( 4, 0xA5, "CS past 4" );
+
+    /* Make a Forth string for testing ForthStringToC. */
+    CStringToForth( fpad, "frog", sizeof(fpad) );
+
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    ForthStringToC( pad, fpad, 6 );
+    ASSERT_PAD_IS( 0, 'f', "FS len 6" );
+    ASSERT_PAD_IS( 3, 'g', "FS end 6" );
+    ASSERT_PAD_IS( 4, 0, "FS nul 6" );
+    ASSERT_PAD_IS( 5, 0xA5, "FS past 6" );
+
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    ForthStringToC( pad, fpad, 5 );
+    ASSERT_PAD_IS( 0, 'f', "FS len 5" );
+    ASSERT_PAD_IS( 3, 'g', "FS end 5" );
+    ASSERT_PAD_IS( 4, 0, "FS nul 5" );
+    ASSERT_PAD_IS( 5, 0xA5, "FS past 5" );
+
+    pfSetMemory(pad,0xA5,sizeof(pad));
+    ForthStringToC( pad, fpad, 4 );
+    ASSERT_PAD_IS( 0, 'f', "FS len 4" );
+    ASSERT_PAD_IS( 2, 'o', "FS end 4" );
+    ASSERT_PAD_IS( 3, 0, "FS nul 4" );
+    ASSERT_PAD_IS( 4, 0xA5, "FS past 4" );
+
+    return numErrors;
+}
+#endif