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 |