1 /* @(#) pf_text.c 98/01/26 1.3 */
2 /***************************************************************
3 ** Text Strings for Error Messages
6 ** For PForth based on 'C'
9 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
11 ** Permission to use, copy, modify, and/or distribute this
12 ** software for any purpose with or without fee is hereby granted.
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.
23 ****************************************************************
24 ** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers.
25 ** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash.
26 ***************************************************************/
33 ** Define array of error messages.
34 ** These are defined in one place to make it easier to translate them.
37 /***************************************************************/
38 void pfReportError( const char *FunctionName, Err ErrCode )
46 switch(ErrCode & 0xFF)
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;
91 s = "unrecognized error code!"; break;
97 void pfReportThrow( ThrowCode code )
103 case THROW_ABORT_QUOTE:
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;
116 s = "Conditional control structure mismatch!"; break;
120 case THROW_SEMICOLON:
121 s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;
123 s = "Not a DEFERred word!"; break;
125 s = "Unrecognized throw code!"; break;
130 MSG_NUM_D("THROW code = ", code );
137 /**************************************************************
138 ** Copy a Forth String to a 'C' string.
141 char *ForthStringToC( char *dst, const char *FString, cell_t dstSize )
145 Len = (cell_t) *FString;
146 /* Make sure the text + NUL can fit. */
151 pfCopyMemory( dst, FString+1, Len );
157 /**************************************************************
158 ** Copy a NUL terminated string to a Forth counted string.
160 char *CStringToForth( char *dst, const char *CString, cell_t dstSize )
164 /* Make sure the SIZE+text can fit. */
165 for( i=1; i<dstSize; i++ )
177 /**************************************************************
178 ** Compare two test strings, case sensitive.
179 ** Return TRUE if they match.
181 cell_t ffCompareText( const char *s1, const char *s2, cell_t len )
186 for( i=0; i<len; i++ )
188 DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));
195 DBUGX(("ffCompareText: return 0x%x\n", Result ));
199 /**************************************************************
200 ** Compare two test strings, case INsensitive.
201 ** Return TRUE if they match.
203 cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )
209 for( i=0; i<len; i++ )
211 c1 = pfCharToLower(*s1++);
212 c2 = pfCharToLower(*s2++);
213 DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));
220 DBUGX(("ffCompareText: return 0x%x\n", Result ));
224 /**************************************************************
225 ** Compare two strings, case sensitive.
226 ** Return zero if they match, -1 if s1<s2, +1 is s1>s2;
228 cell_t ffCompare( const char *s1, cell_t len1, const char *s2, cell_t len2 )
230 cell_t i, result, n, diff;
236 if( (diff = (*s2++ - *s1++)) != 0 )
238 result = (diff > 0) ? -1 : 1 ;
242 if( result == 0 ) /* Match up to MIN(len1,len2) */
248 else if ( len1 > len2 )
256 /***************************************************************
257 ** Convert number to text.
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];
262 char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )
264 cell_t IfNegative = 0;
266 ucell_t NewNum, Rem, uNum;
272 /* Convert to positive and keep sign. */
280 /* Point past end of Pad */
281 p = cnttPad + CNTT_PAD_SIZE;
282 *(--p) = (char) 0; /* NUL terminate */
284 while( (i++<MinChars) || (uNum != 0) )
286 NewNum = uNum / Base;
287 Rem = uNum - (NewNum * Base);
288 c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));
295 if( IfNegative ) *(--p) = '-';
300 /***************************************************************
301 ** Diagnostic routine that prints memory in table format.
303 void DumpMemory( void *addr, cell_t cnt)
305 cell_t ln, cn, nlines;
306 unsigned char *ptr, *cptr, c;
308 nlines = (cnt + 15) / 16;
310 ptr = (unsigned char *) addr;
314 for (ln=0; ln<nlines; ln++)
316 MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );
319 for (cn=0; cn<16; cn++)
321 MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );
325 for (cn=0; cn<16; cn++)
328 if ((c < ' ') || (c > '}')) c = '.';
336 /* Print name, mask off any dictionary bits. */
337 void TypeName( const char *Name )
339 const char *FirstChar;
345 ioType( FirstChar, Len );
351 /* Unit test for string conversion routines. */
352 #define ASSERT_PAD_IS( index, value, msg ) \
353 if( pad[index] != ((char)(value)) ) \
355 ERR(( "ERROR text test failed: " msg "\n")); \
359 cell_t pfUnitTestText( void )
361 cell_t numErrors = 0;
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" );
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" );
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" );
384 /* Make a Forth string for testing ForthStringToC. */
385 CStringToForth( fpad, "frog", sizeof(fpad) );
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" );
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" );
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" );