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