projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
V25 with 64-bit support
[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
138char *ForthStringToC( char *dst, const char *FString )\r
139{\r
1cb310e6 140 cell_t Len;\r
bb6b2dcd 141\r
1cb310e6 142 Len = (cell_t) *FString;\r
bb6b2dcd 143 pfCopyMemory( dst, FString+1, Len );\r
144 dst[Len] = '\0';\r
145\r
146 return dst;\r
147}\r
148\r
149/**************************************************************\r
150** Copy a NUL terminated string to a Forth counted string.\r
151*/\r
152char *CStringToForth( char *dst, const char *CString )\r
153{\r
154 char *s;\r
1cb310e6 155 cell_t i;\r
bb6b2dcd 156\r
157 s = dst+1;\r
158 for( i=0; *CString; i++ )\r
159 {\r
160 *s++ = *CString++;\r
161 }\r
162 *dst = (char ) i;\r
163 return dst;\r
164}\r
165\r
166/**************************************************************\r
167** Compare two test strings, case sensitive.\r
168** Return TRUE if they match.\r
169*/\r
1cb310e6 170cell_t ffCompareText( const char *s1, const char *s2, cell_t len )\r
bb6b2dcd 171{\r
1cb310e6 172 cell_t i, Result;\r
bb6b2dcd 173 \r
174 Result = TRUE;\r
175 for( i=0; i<len; i++ )\r
176 {\r
177DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));\r
178 if( *s1++ != *s2++ )\r
179 {\r
180 Result = FALSE;\r
181 break;\r
182 }\r
183 }\r
184DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
185 return Result;\r
186}\r
187\r
188/**************************************************************\r
189** Compare two test strings, case INsensitive.\r
190** Return TRUE if they match.\r
191*/\r
1cb310e6 192cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )\r
bb6b2dcd 193{\r
1cb310e6 194 cell_t i, Result;\r
bb6b2dcd 195 char c1,c2;\r
196 \r
197 Result = TRUE;\r
198 for( i=0; i<len; i++ )\r
199 {\r
200 c1 = pfCharToLower(*s1++);\r
201 c2 = pfCharToLower(*s2++);\r
202DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));\r
203 if( c1 != c2 )\r
204 {\r
205 Result = FALSE;\r
206 break;\r
207 }\r
208 }\r
209DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
210 return Result;\r
211}\r
212\r
213/**************************************************************\r
214** Compare two strings, case sensitive.\r
215** Return zero if they match, -1 if s1<s2, +1 is s1>s2;\r
216*/\r
1cb310e6 217cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 )\r
bb6b2dcd 218{\r
1cb310e6 219 cell_t i, result, n, diff;\r
bb6b2dcd 220 \r
221 result = 0;\r
222 n = MIN(len1,len2);\r
223 for( i=0; i<n; i++ )\r
224 {\r
225 if( (diff = (*s2++ - *s1++)) != 0 )\r
226 {\r
227 result = (diff > 0) ? -1 : 1 ;\r
228 break;\r
229 }\r
230 }\r
231 if( result == 0 ) /* Match up to MIN(len1,len2) */\r
232 {\r
233 if( len1 < len2 )\r
234 {\r
235 result = -1;\r
236 }\r
237 else if ( len1 > len2 )\r
238 {\r
239 result = 1;\r
240 }\r
241 }\r
242 return result;\r
243}\r
244\r
245/***************************************************************\r
246** Convert number to text.\r
247*/\r
1cb310e6 248#define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2) /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */\r
bb6b2dcd 249static char cnttPad[CNTT_PAD_SIZE];\r
250\r
1cb310e6 251char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )\r
bb6b2dcd 252{\r
1cb310e6 253 cell_t IfNegative = 0;\r
bb6b2dcd 254 char *p,c;\r
1cb310e6 255 ucell_t NewNum, Rem, uNum;\r
256 cell_t i = 0;\r
bb6b2dcd 257 \r
258 uNum = Num;\r
259 if( IfSigned )\r
260 {\r
261/* Convert to positive and keep sign. */\r
262 if( Num < 0 )\r
263 {\r
264 IfNegative = TRUE;\r
265 uNum = -Num;\r
266 }\r
267 }\r
268 \r
269/* Point past end of Pad */\r
270 p = cnttPad + CNTT_PAD_SIZE;\r
271 *(--p) = (char) 0; /* NUL terminate */\r
272 \r
273 while( (i++<MinChars) || (uNum != 0) )\r
274 {\r
275 NewNum = uNum / Base;\r
276 Rem = uNum - (NewNum * Base);\r
277 c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));\r
278 *(--p) = c;\r
279 uNum = NewNum;\r
280 }\r
281 \r
282 if( IfSigned )\r
283 {\r
284 if( IfNegative ) *(--p) = '-';\r
285 }\r
286 return p;\r
287}\r
288\r
289/***************************************************************\r
290** Diagnostic routine that prints memory in table format.\r
291*/\r
1cb310e6 292void DumpMemory( void *addr, cell_t cnt)\r
bb6b2dcd 293{\r
1cb310e6 294 cell_t ln, cn, nlines;\r
bb6b2dcd 295 unsigned char *ptr, *cptr, c;\r
296\r
297 nlines = (cnt + 15) / 16;\r
298\r
299 ptr = (unsigned char *) addr;\r
300\r
301 EMIT_CR;\r
302 \r
303 for (ln=0; ln<nlines; ln++)\r
304 {\r
1cb310e6 305 MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );\r
bb6b2dcd 306 MSG(": ");\r
307 cptr = ptr;\r
308 for (cn=0; cn<16; cn++)\r
309 {\r
1cb310e6 310 MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );\r
bb6b2dcd 311 EMIT(' ');\r
312 }\r
313 EMIT(' ');\r
314 for (cn=0; cn<16; cn++)\r
315 {\r
316 c = *ptr++;\r
317 if ((c < ' ') || (c > '}')) c = '.';\r
318 EMIT(c);\r
319 }\r
320 EMIT_CR;\r
321 }\r
322}\r
323\r
324\r
325/* Print name, mask off any dictionary bits. */\r
326void TypeName( const char *Name )\r
327{\r
328 const char *FirstChar;\r
1cb310e6 329 cell_t Len;\r
bb6b2dcd 330 \r
331 FirstChar = Name+1;\r
332 Len = *Name & 0x1F;\r
333 \r
334 ioType( FirstChar, Len );\r
335}\r
336\r
337\r
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.