[pforth] / csrc / pf_text.c

/* @(#) 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
**
** Permission to use, copy, modify, and/or distribute this
** software for any purpose with or without fee is hereby granted.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
**
****************************************************************
** 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, cell_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
Commit	Line	Data
8e9db35f PB	1	/* @(#) pf_text.c 98/01/26 1.3 */
	2	/***************************************************************
	3	** Text Strings for Error Messages
	4	** Various Text tools.
	5	**
	6	** For PForth based on 'C'
	7	**
	8	** Author: Phil Burk
	9	** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
	10	**
1f99f95d S	11	** Permission to use, copy, modify, and/or distribute this
	12	** software for any purpose with or without fee is hereby granted.
	13	**
	14	** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
	15	** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
	16	** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
	17	** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
	18	** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
	19	** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
	20	** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
	21	** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
8e9db35f PB	22	**
	23	****************************************************************
	24	** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers.
	25	** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash.
	26	***************************************************************/
	27
	28	#include "pf_all.h"
	29
	30	#define PF_ENGLISH
	31
	32	/*
	33	** Define array of error messages.
	34	** These are defined in one place to make it easier to translate them.
	35	*/
	36	#ifdef PF_ENGLISH
	37	/***************************************************************/
	38	void pfReportError( const char *FunctionName, Err ErrCode )
	39	{
	40	const char *s;
	41
	42	MSG("Error in ");
	43	MSG(FunctionName);
	44	MSG(" - ");
	45
	46	switch(ErrCode & 0xFF)
	47	{
	48	case PF_ERR_NO_MEM & 0xFF:
	49	s = "insufficient memory"; break;
	50	case PF_ERR_TOO_BIG & 0xFF:
	51	s = "data chunk too large"; break;
	52	case PF_ERR_NUM_PARAMS & 0xFF:
	53	s = "incorrect number of parameters"; break;
	54	case PF_ERR_OPEN_FILE & 0xFF:
	55	s = "could not open file"; break;
	56	case PF_ERR_WRONG_FILE & 0xFF:
	57	s = "wrong type of file format"; break;
	58	case PF_ERR_BAD_FILE & 0xFF:
	59	s = "badly formatted file"; break;
	60	case PF_ERR_READ_FILE & 0xFF:
	61	s = "file read failed"; break;
	62	case PF_ERR_WRITE_FILE & 0xFF:
	63	s = "file write failed"; break;
	64	case PF_ERR_CORRUPT_DIC & 0xFF:
	65	s = "corrupted dictionary"; break;
	66	case PF_ERR_NOT_SUPPORTED & 0xFF:
	67	s = "not supported in this version"; break;
	68	case PF_ERR_VERSION_FUTURE & 0xFF:
	69	s = "version from future"; break;
	70	case PF_ERR_VERSION_PAST & 0xFF:
	71	s = "version is obsolete. Rebuild new one."; break;
	72	case PF_ERR_COLON_STACK & 0xFF:
	73	s = "stack depth changed between : and ; . Probably unbalanced conditional"; break;
	74	case PF_ERR_HEADER_ROOM & 0xFF:
	75	s = "no room left in header space"; break;
	76	case PF_ERR_CODE_ROOM & 0xFF:
	77	s = "no room left in code space"; break;
	78	case PF_ERR_NO_SHELL & 0xFF:
	79	s = "attempt to use names in forth compiled with PF_NO_SHELL"; break;
	80	case PF_ERR_NO_NAMES & 0xFF:
	81	s = "dictionary has no names"; break;
	82	case PF_ERR_OUT_OF_RANGE & 0xFF:
	83	s = "parameter out of range"; break;
	84	case PF_ERR_ENDIAN_CONFLICT & 0xFF:
	85	s = "endian-ness of dictionary does not match code"; break;
86	case PF_ERR_FLOAT_CONFLICT & 0xFF:
87	s = "float support mismatch between .dic file and code"; break;
88	case PF_ERR_CELL_SIZE_CONFLICT & 0xFF:
89	s = "cell size mismatch between .dic file and code"; break;
90	default:
91	s = "unrecognized error code!"; break;
92	}
93	MSG(s);
94	EMIT_CR;
95	}
96
97	void pfReportThrow( ThrowCode code )
98	{
99	const char *s = NULL;
100	switch(code)
101	{
102	case THROW_ABORT:
103	case THROW_ABORT_QUOTE:
104	s = "ABORT"; break;
105	case THROW_STACK_OVERFLOW:
106	s = "Stack overflow!"; break;
107	case THROW_STACK_UNDERFLOW:
108	s = "Stack underflow!"; break;
109	case THROW_EXECUTING:
110	s = "Executing a compile-only word!"; break;
111	case THROW_FLOAT_STACK_UNDERFLOW:
112	s = "Float Stack underflow!"; break;
113	case THROW_UNDEFINED_WORD:
114	s = "Undefined word!"; break;
115	case THROW_PAIRS:
116	s = "Conditional control structure mismatch!"; break;
117	case THROW_BYE:
118	case THROW_QUIT:
119	break;
120	case THROW_SEMICOLON:
121	s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;
122	case THROW_DEFERRED:
123	s = "Not a DEFERred word!"; break;
124	default:
125	s = "Unrecognized throw code!"; break;
126	}
127
128	if( s )
129	{
130	MSG_NUM_D("THROW code = ", code );
131	MSG(s);
132	EMIT_CR;
133	}
134	}
135	#endif
136
137	/**************************************************************
138	** Copy a Forth String to a 'C' string.
139	*/
140
141	char ForthStringToC( char dst, const char *FString, cell_t dstSize )
142	{
143	cell_t Len;
144
145	Len = (cell_t) *FString;
146	/* Make sure the text + NUL can fit. */
147	if( Len >= dstSize )
148	{
149	Len = dstSize - 1;
150	}
151	pfCopyMemory( dst, FString+1, Len );
152	dst[Len] = '\0';
153
154	return dst;
155	}
156
157	/**************************************************************
158	** Copy a NUL terminated string to a Forth counted string.
159	*/
160	char CStringToForth( char dst, const char *CString, cell_t dstSize )
161	{
162	cell_t i;
163
164	/* Make sure the SIZE+text can fit. */
165	for( i=1; i<dstSize; i++ )
166	{
167	if( *CString == 0 )
168	{
169	break;
170	}
171	dst[i] = *CString++;
172	}
173	*dst = (char ) i-1;
174	return dst;
175	}
176
177	/**************************************************************
178	** Compare two test strings, case sensitive.
179	** Return TRUE if they match.
180	*/
181	cell_t ffCompareText( const char s1, const char s2, cell_t len )
182	{
183	cell_t i, Result;
184
185	Result = TRUE;
186	for( i=0; i<len; i++ )
187	{
188	DBUGX(("ffCompareText: s1 = 0x%x, s2 = 0x%x\n", s1, s2 ));
189	if( s1++ != s2++ )
190	{
191	Result = FALSE;
192	break;
193	}
194	}
195	DBUGX(("ffCompareText: return 0x%x\n", Result ));
196	return Result;
197	}
198
199	/**************************************************************
200	** Compare two test strings, case INsensitive.
201	** Return TRUE if they match.
202	*/
203	cell_t ffCompareTextCaseN( const char s1, const char s2, cell_t len )
204	{
205	cell_t i, Result;
206	char c1,c2;
207
208	Result = TRUE;
209	for( i=0; i<len; i++ )
210	{
211	c1 = pfCharToLower(*s1++);
212	c2 = pfCharToLower(*s2++);
213	DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));
214	if( c1 != c2 )
215	{
216	Result = FALSE;
217	break;
218	}
219	}
220	DBUGX(("ffCompareText: return 0x%x\n", Result ));
221	return Result;
222	}
223
224	/**************************************************************
225	** Compare two strings, case sensitive.
226	** Return zero if they match, -1 if s1<s2, +1 is s1>s2;
227	*/
529bb4e2	228	cell_t ffCompare( const char s1, cell_t len1, const char s2, cell_t len2 )
8e9db35f PB	229	{
	230	cell_t i, result, n, diff;
	231
	232	result = 0;
	233	n = MIN(len1,len2);
	234	for( i=0; i<n; i++ )
	235	{
	236	if( (diff = (s2++ - s1++)) != 0 )
	237	{
	238	result = (diff > 0) ? -1 : 1 ;
	239	break;
	240	}
	241	}
	242	if( result == 0 ) /* Match up to MIN(len1,len2) */
	243	{
	244	if( len1 < len2 )
	245	{
	246	result = -1;
	247	}
	248	else if ( len1 > len2 )
	249	{
	250	result = 1;
	251	}
	252	}
	253	return result;
	254	}
	255
	256	/***************************************************************
	257	** Convert number to text.
	258	*/
	259	#define CNTT_PAD_SIZE ((sizeof(cell_t)8)+2) / PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */
	260	static char cnttPad[CNTT_PAD_SIZE];
	261
	262	char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )
	263	{
	264	cell_t IfNegative = 0;
	265	char *p,c;
	266	ucell_t NewNum, Rem, uNum;
	267	cell_t i = 0;
	268
	269	uNum = Num;
	270	if( IfSigned )
	271	{
	272	/* Convert to positive and keep sign. */
	273	if( Num < 0 )
	274	{
	275	IfNegative = TRUE;
	276	uNum = -Num;
	277	}
	278	}
	279
	280	/* Point past end of Pad */
	281	p = cnttPad + CNTT_PAD_SIZE;
	282	(--p) = (char) 0; / NUL terminate */
	283
	284	while( (i++<MinChars) \|\| (uNum != 0) )
	285	{
	286	NewNum = uNum / Base;
	287	Rem = uNum - (NewNum * Base);
	288	c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));
	289	*(--p) = c;
	290	uNum = NewNum;
	291	}
	292
293	if( IfSigned )
294	{
295	if( IfNegative ) *(--p) = '-';
296	}
297	return p;
298	}
299
300	/***************************************************************
301	** Diagnostic routine that prints memory in table format.
302	*/
303	void DumpMemory( void *addr, cell_t cnt)
304	{
305	cell_t ln, cn, nlines;
306	unsigned char ptr, cptr, c;
307
308	nlines = (cnt + 15) / 16;
309
310	ptr = (unsigned char *) addr;
311
312	EMIT_CR;
313
314	for (ln=0; ln<nlines; ln++)
315	{
316	MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );
317	MSG(": ");
318	cptr = ptr;
319	for (cn=0; cn<16; cn++)
320	{
321	MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );
322	EMIT(' ');
323	}
324	EMIT(' ');
325	for (cn=0; cn<16; cn++)
326	{
327	c = *ptr++;
328	if ((c < ' ') \|\| (c > '}')) c = '.';
329	EMIT(c);
330	}
331	EMIT_CR;
332	}
333	}
334
335
336	/* Print name, mask off any dictionary bits. */
337	void TypeName( const char *Name )
338	{
339	const char *FirstChar;
340	cell_t Len;
341
342	FirstChar = Name+1;
343	Len = *Name & 0x1F;
344
345	ioType( FirstChar, Len );
346	}
347
348
349
350	#ifdef PF_UNIT_TEST
351	/* Unit test for string conversion routines. */
352	#define ASSERT_PAD_IS( index, value, msg ) \
353	if( pad[index] != ((char)(value)) ) \
354	{ \
355	ERR(( "ERROR text test failed: " msg "\n")); \
356	numErrors += 1; \
357	} \
358
359	cell_t pfUnitTestText( void )
360	{
361	cell_t numErrors = 0;
362	char pad[16];
363	char fpad[8];
364
365	/* test CStringToForth */
366	pfSetMemory(pad,0xA5,sizeof(pad));
367	CStringToForth( pad, "frog", 6 );
368	ASSERT_PAD_IS( 0, 4, "CS len 6" );
369	ASSERT_PAD_IS( 4, 'g', "CS end 6" );
370	ASSERT_PAD_IS( 5, 0xA5, "CS past 6" );
371
372	pfSetMemory(pad,0xA5,sizeof(pad));
373	CStringToForth( pad, "frog", 5 );
374	ASSERT_PAD_IS( 0, 4, "CS len 5" );
375	ASSERT_PAD_IS( 4, 'g', "CS end 5" );
376	ASSERT_PAD_IS( 5, 0xA5, "CS past 5" );
377
378	pfSetMemory(pad,0xA5,sizeof(pad));
379	CStringToForth( pad, "frog", 4 );
380	ASSERT_PAD_IS( 0, 3, "CS len 4" );
381	ASSERT_PAD_IS( 3, 'o', "CS end 4" );
382	ASSERT_PAD_IS( 4, 0xA5, "CS past 4" );
383
384	/* Make a Forth string for testing ForthStringToC. */
385	CStringToForth( fpad, "frog", sizeof(fpad) );
386
387	pfSetMemory(pad,0xA5,sizeof(pad));
388	ForthStringToC( pad, fpad, 6 );
389	ASSERT_PAD_IS( 0, 'f', "FS len 6" );
390	ASSERT_PAD_IS( 3, 'g', "FS end 6" );
391	ASSERT_PAD_IS( 4, 0, "FS nul 6" );
392	ASSERT_PAD_IS( 5, 0xA5, "FS past 6" );
393
394	pfSetMemory(pad,0xA5,sizeof(pad));
395	ForthStringToC( pad, fpad, 5 );
396	ASSERT_PAD_IS( 0, 'f', "FS len 5" );
397	ASSERT_PAD_IS( 3, 'g', "FS end 5" );
398	ASSERT_PAD_IS( 4, 0, "FS nul 5" );
399	ASSERT_PAD_IS( 5, 0xA5, "FS past 5" );
400
401	pfSetMemory(pad,0xA5,sizeof(pad));
402	ForthStringToC( pad, fpad, 4 );
403	ASSERT_PAD_IS( 0, 'f', "FS len 4" );
404	ASSERT_PAD_IS( 2, 'o', "FS end 4" );
405	ASSERT_PAD_IS( 3, 0, "FS nul 4" );
406	ASSERT_PAD_IS( 4, 0xA5, "FS past 4" );
407
408	return numErrors;
409	}
410	#endif